unit Mod_Common;

interface

uses
  Windows, Messages, SysUtils, Classes, ComCtrls, aPLibu, xBase, Dialogs;

type
  TDataItem = record
    cType,
    cSubtype,
    cbData: Integer;
    Data: String;
  end;

  PTreeNode = ^TTreeNode;
  TModule = class(TObject)
  private
    FShouldExpand: Boolean;
    FCurNode: PTreeNode;
    FTreeView: TTreeView;
    FStream: TMemoryStream;
    FDBStream: TMemoryStream;
    procedure SetTreeView(TreeView: TTreeView);
  protected
    FImportedID: Integer;
    FImportedVersion: Integer;
    FExecuted: Boolean;
    FError: Integer;

    class function GetModuleName: String; virtual; abstract;
    class function GetModuleVersion: Integer; virtual; abstract;
    class function GetModuleID: Integer; virtual; abstract;
    function GetIsEmpty: Boolean; virtual; abstract;

    function ReadNextDataType: TDataItem;
    function ReadData: TDataItem;
    function HasMoreData: Boolean;

    procedure MoveIn;
    procedure MoveOut;
    procedure Expand;
    procedure Append(const ItemName, Data: String; IconIndex: Integer);

    procedure ExportData(const Args: array of const);
    function ImportData: Variant;
  public
    constructor Create(OutList: TList; M: TMemoryStream = nil);
    destructor Destroy; override;

    procedure FreeInputStream;

    procedure Run; virtual;
    procedure ExportModule(DBStream: TMemoryStream); virtual;
    procedure ImportModule(DBStream: TMemoryStream); virtual;

    function GetAsText: String; virtual; abstract;
    procedure GetAsTree; virtual; abstract;

    property ModuleName: String read GetModuleName;
    property ModuleVersion: Integer read GetModuleVersion;
    property ModuleID: Integer read GetModuleID;
    property IsEmpty: Boolean read GetIsEmpty;

    property Error: Integer read FError;
    property Executed: Boolean read FExecuted;
    property TreeView: TTreeView write SetTreeView; // Used in GetAsTree()
  end;

  TModuleParser = class(TObject)
  private
    FCurNode: TTreeNode;
    FTreeView: TTreeView;
    FError: Integer;
    FHashSysInfo: Int64;
    FHashModules: Int64;
    function GetIsAllEmpty: Boolean;
    procedure FreeModuleList;
    procedure FreeTreeViewData;
    function GetHash: Int64;
  public
    ErrClassName: String;
    ModuleList: TList;

    constructor Create(T: TTreeView = nil);
    destructor Destroy; override;

    procedure LoadFromFile(const FileName: String); // Load out.bin from file, parse modules
    procedure RunAll; // Decrypt all parsed modules
    function ExportAll: TMemoryStream; // Export all modules to stream
    procedure ImportAll(DBStream: TMemoryStream); // Import all modules from stream
    function ErrorToStr(Error: Integer): String;

    property Error: Integer read FError;
    property IsAllEmpty: Boolean read GetIsAllEmpty;
    property HashSysInfo: Int64 read FHashSysInfo;
    property HashModules: Int64 read FHashModules;
    property Hash: Int64 read GetHash;
  end;

const
  ERR_PARSING             = 1;  // Parsing error
  ERR_UNK_MODULE          = 2;  // Unknown module
  ERR_UNK_ITEM            = 3;  // Unknown item
  ERR_MOD_INTERNAL        = 4;  // Internal module error
  ERR_INV_DB              = 5;  // Invalid database format 

  // Icon indexes
  ICON_PACKET             = 0;
  ICON_FOLDER_CLOSED      = 1;
  ICON_FOLDER_OPENED      = 2;
  ICON_FOLDER             = ICON_FOLDER_CLOSED;
  ICON_ITEM               = 3;
  ICON_CPU                = 4;
  ICON_USER               = 5;
  ICON_MEMORY             = 6;
  ICON_OS                 = 7;
  ICON_ICQ                = 8;
  ICON_THE_BAT            = 9;
  ICON_MIRANDA            = 10;
  ICON_FAR                = 11;
  ICON_OUTLOOK            = 12;
  ICON_IE                 = 13;
  ICON_TRILLIAN           = 14;
  ICON_ICQB               = 15;
  ICON_DISK               = 16;
  ICON_REMDISK            = 17;
  ICON_NETDISK            = 18;
  ICON_CDROM              = 19;
  ICON_RAS                = 20;
  ICON_IP                 = 21;
  ICON_PS_FORMS           = 22;
  ICON_PROGS_INSTALL      = 23;
  ICON_TASKS              = 24;
  ICON_WS_FTP             = 25;
  ICON_PS_FTP             = 26;
  ICON_BECKY              = 27;
  ICON_EDIALER            = 28;
  ICON_PS_SITES           = 29;
  ICON_CUTE_FTP           = 30;
  ICON_OPERA              = 31;
  ICON_OPERA_MAIL         = 32;
  ICON_RQ                 = 33;
  ICON_TOTAL              = 34;
  ICON_FOLDERS            = 35;
  ICON_MOZILLA            = 36;

  MODULE_SYSINFO          = 0;
  MODULE_ICQ_2003         = 1;
  MODULE_THE_BAT          = 2;
  MODULE_ICQ_99b          = 3;
  MODULE_MIRANDA          = 4;
  MODULE_RQ               = 5;
  MODULE_RAS              = 6;
  MODULE_FAR              = 7;
  MODULE_TRILLIAN         = 8;
  MODULE_WTC              = 9;
  MODULE_PSTORAGE         = 10;
  MODULE_BECKY            = 11;
  MODULE_CUTEFTP          = 12;
  MODULE_EDIALER          = 13;
  MODULE_WS_FTP           = 14;
  MODULE_OPERA            = 15;
  MODULE_MOZILLA          = 16;

implementation

uses
  Mod_SysInfo, Mod_TheBat, Mod_ICQ99b, Mod_ICQ2003, Mod_Miranda, Mod_RQ, Mod_RAS, Mod_FAR,
  Mod_Trillian, Mod_WTC, Mod_Becky, Mod_PStorage, Mod_CuteFTP, Mod_EDialer, Mod_WS_FTP,
  Mod_Opera, Mod_Mozilla;

const
  ModHeader: PChar = 'PMOD';
  ModPacked: PChar = 'PACK';
  MODULE_END       = $ffffffff; // End of module list

{ TModuleParser }

constructor TModuleParser.Create(T: TTreeView);
begin
  if T = nil then Exit;
  ErrClassName := ClassName;
  FTreeView := T;
  FTreeView.Tag := LongWord(@FCurNode);
end;

destructor TModuleParser.Destroy;
begin
  FreeTreeViewData;
  FreeModuleList;
  inherited;
end;

procedure TModuleParser.FreeTreeViewData;
var
  i: Integer;
begin
  if FTreeView = nil then Exit;
  for i := 0 to FTreeView.Items.Count-1 do
    if FTreeView.Items[i].Data <> nil then begin
      FreeMem(FTreeView.Items[i].Data);
      FTreeView.Items[i].Data := nil;
    end;
  FTreeView.Items.Clear;
end;

procedure TModuleParser.FreeModuleList;
var
  i: Integer;
begin
  if ModuleList = nil then Exit;

  for i := 0 to ModuleList.Count-1 do
    TObject(ModuleList.Items[i]).Free;
  ModuleList.Free;

  ModuleList := nil;
end;

procedure TModuleParser.LoadFromFile(const FileName: String);
var
  M: TMemoryStream;
  ModuleData: TMemoryStream;

  P, MType, MSize: LongWord;
  A: array[0..4] of Char;

  MemSize: LongWord;
  Mem: Pointer;

  Hash1, Hash2: Int64;

begin
  ModuleList := TList.Create;

  M := TMemoryStream.Create;
  M.LoadFromFile(FileName);
  M.Seek(0, 0);

  if M.Size <= 4 then begin
    FError := ERR_PARSING;
    M.Free;
    Exit;
  end;

  M.ReadBuffer(A, 4); A[4] := #0;
  if String(PChar(@A[0])) = ModPacked then begin
    if M.Size <= 8 then begin
      FError := ERR_PARSING;
      M.Free;
      Exit;
    end;

    MemSize := PLongWord(Integer(M.Memory)+4)^;
    GetMem(Mem, MemSize);

    _aP_depack_asm_fast(Pointer(Integer(M.Memory)+8)^, Mem^);

    M.Clear;
    M.WriteBuffer(Mem^, MemSize);
    FreeMem(Mem);
  end;
  M.Seek(0, 0);  

  Hash1 := 0; Hash2 := 0;
  while True do begin
    M.ReadBuffer(A, 4);
    A[4] := #0;
    if String(PChar(@A[0])) = ModHeader then begin
      P := M.Seek(0, 1)-4+Integer(M.Memory);
      MSize := PLongWord(P+8)^;
      if LongWord(M.Seek(0, 1))+MSize+8 > M.Size then begin
        FError := ERR_PARSING;
        M.Free;
        Exit;
      end;
      ModuleData := TMemoryStream.Create;
      ModuleData.WriteBuffer(Pointer(P)^, MSize+8);
      M.Seek(MSize+4, 1); // Move to next module
      MType := PInteger(P+4)^;

      if (MType <> MODULE_SYSINFO) and (MType <> MODULE_END) then begin
        Hash2 := CRC64Update(Hash2, ModuleData.Memory, ModuleData.Size);
      end;

      case MType of
        MODULE_SYSINFO: begin
          TModuleSysInfo.Create(ModuleList, ModuleData);
          Hash1 := CRC64Update(0, ModuleData.Memory, ModuleData.Size);
        end;
        MODULE_THE_BAT:
          TModuleTheBat.Create(ModuleList, ModuleData);
        MODULE_ICQ_99b:
          TModuleICQ99b.Create(ModuleList, ModuleData);
        MODULE_ICQ_2003:
          TModuleICQ2003.Create(ModuleList, ModuleData);
        MODULE_MIRANDA:
          TModuleMiranda.Create(ModuleList, ModuleData);
        MODULE_RQ:
          TModuleRQ.Create(ModuleList, ModuleData);
        MODULE_RAS:
          TModuleRAS.Create(ModuleList, ModuleData);
        MODULE_FAR:
          TModuleFAR.Create(ModuleList, ModuleData);
        MODULE_TRILLIAN:
          TModuleTrillian.Create(ModuleList, ModuleData);
        MODULE_WTC:
          TModuleWTC.Create(ModuleList, ModuleData);
        MODULE_BECKY:
          TModuleBecky.Create(ModuleList, ModuleData);
        MODULE_PSTORAGE:
          TModulePStorage.Create(ModuleList, ModuleData);
        MODULE_CUTEFTP:
          TModuleCuteFTP.Create(ModuleList, ModuleData);
        MODULE_EDIALER:
          TModuleEDialer.Create(ModuleList, ModuleData);
        MODULE_WS_FTP:
          TModuleWS_FTP.Create(ModuleList, ModuleData);
        MODULE_OPERA:
          TModuleOpera.Create(ModuleList, ModuleData);
        MODULE_MOZILLA:
          TModuleMozilla.Create(ModuleList, ModuleData);
        MODULE_END: begin
          ModuleData.Free;
          Break;
        end;
      else begin
          FError := ERR_UNK_MODULE;
          ModuleData.Free;
          M.Free;
          Exit;
        end;
      end;
    end else begin
      FError := ERR_PARSING;
      M.Free;
      Exit;
    end;
  end;
  
  M.Free;

  FHashSysInfo := Hash1;
  FHashModules := Hash2;
end;

procedure TModuleParser.RunAll;
var
  i: Integer;
begin
  if ModuleList = nil then Exit;
  if FError <> 0 then Exit;
  for i := 0 to ModuleList.Count-1 do
    if not TModule(ModuleList.Items[i]).Executed then begin
      TModule(ModuleList.Items[i]).TreeView := FTreeView;
      TModule(ModuleList.Items[i]).Run;
      if TModule(ModuleList.Items[i]).FError <> 0 then begin
        ErrClassName := TModule(ModuleList.Items[i]).ClassName;
        FError := TModule(ModuleList.Items[i]).FError;
        Exit;
      end;
    end;
end;

function TModuleParser.ExportAll: TMemoryStream;
var
  i, data: Integer;
  p: LongWord;
begin
  Result := nil;
  if ModuleList = nil then Exit;
  if FError <> 0 then Exit;
  if ModuleList.Count = 0 then Exit;

  Result := TMemoryStream.Create;

  // Write parser version
  data := 0;
  Result.WriteBuffer(data, 4);
  // Write module count
  data := ModuleList.Count;
  Result.WriteBuffer(data, 4);

  // Write module index
  p := Result.Position + 8;
  for i := 0 to ModuleList.Count-1 do
    if TModule(ModuleList.Items[i]).Executed then begin
      // ID (type)
      data := TModule(ModuleList.Items[i]).ModuleID;
      Result.WriteBuffer(data, 4);
      // IsEmpty?
      data := Ord(TModule(ModuleList.Items[i]).IsEmpty);
      Result.WriteBuffer(data, 4);
      // Offset (reserve space)
      data := 0;
      Result.WriteBuffer(data, 4);
    end;

  // Write module data
  for i := 0 to ModuleList.Count-1 do begin
    if TModule(ModuleList.Items[i]).Executed then begin
      data := Result.Size;
      Result.Seek(p, 0); // Seek module index
      Result.WriteBuffer(data, 4); // Write module offset in index record
      Result.Seek(0, 2); // Seek end
      TModule(ModuleList.Items[i]).ExportModule(Result); // Write the data
    end else begin
      FError := ERR_MOD_INTERNAL;
      Result.Free;
      Result := nil;
      Exit;
    end;
    p := p + 12;
  end;
end;

procedure TModuleParser.ImportAll(DBStream: TMemoryStream);
var
  Module: TModule;
  i, p, Count: Integer;

  ID: Integer;
  IsEmpty: Integer;
  Offset: Integer;
begin
  if FError <> 0 then Exit;

  DBStream.Seek(0, 0);

  // Check parser version
  DBStream.ReadBuffer(ID, 4);
  if ID <> 0 then begin
    FError := ERR_INV_DB;
    Exit;
  end;

  ModuleList := TList.Create;
    
  DBStream.ReadBuffer(Count, 4);
  p := DBStream.Position;
  Module := nil;

  for i := 0 to Count-1 do begin
    DBStream.ReadBuffer(ID, 4);
    DBStream.ReadBuffer(IsEmpty, 4);
    DBStream.ReadBuffer(Offset, 4);

    DBStream.Seek(Offset, 0);

    case ID of
      MODULE_SYSINFO:
        Module := TModuleSysInfo.Create(ModuleList);
      MODULE_THE_BAT:
        Module := TModuleTheBat.Create(ModuleList);
      MODULE_ICQ_99b:
        Module := TModuleICQ99b.Create(ModuleList);
      MODULE_ICQ_2003:
        Module := TModuleICQ2003.Create(ModuleList);
      MODULE_MIRANDA:
        Module := TModuleMiranda.Create(ModuleList);
      MODULE_RQ:
        Module := TModuleRQ.Create(ModuleList);
      MODULE_RAS:
        Module := TModuleRAS.Create(ModuleList);
      MODULE_FAR:
        Module := TModuleFAR.Create(ModuleList);
      MODULE_TRILLIAN:
        Module := TModuleTrillian.Create(ModuleList);
      MODULE_WTC:
        Module := TModuleWTC.Create(ModuleList);
      MODULE_BECKY:
        Module := TModuleBecky.Create(ModuleList);
      MODULE_PSTORAGE:
        Module := TModulePStorage.Create(ModuleList);
      MODULE_CUTEFTP:
        Module := TModuleCuteFTP.Create(ModuleList);
      MODULE_EDIALER:
        Module := TModuleEDialer.Create(ModuleList);
      MODULE_WS_FTP:
        Module := TModuleWS_FTP.Create(ModuleList);
      MODULE_OPERA:
        Module := TModuleOpera.Create(ModuleList);
      MODULE_MOZILLA:
        Module := TModuleMozilla.Create(ModuleList);      
    else begin
        FError := ERR_UNK_MODULE;
        Exit;
      end;
    end;

    if Module <> nil then begin
      Module.TreeView := FTreeView;
      Module.ImportModule(DBStream);
    end;

    // Move to next dbstream record
    p := p + 12;
    DBStream.Seek(p, 0);
  end;
end;

function TModuleParser.GetIsAllEmpty: Boolean;
var
  i: Integer;
begin
  Result := True;
  if ModuleList = nil then Exit;
  if FError <> 0 then Exit;

  for i := 0 to ModuleList.Count-1 do 
    if (TModule(ModuleList.Items[i]).Executed) and (TModule(ModuleList.Items[i]).ModuleID <> MODULE_SYSINFO) and
       (not TModule(ModuleList.Items[i]).IsEmpty) then begin
         Result := False;
         Exit;
       end;
end;

function TModuleParser.GetHash: Int64;
begin
  if IsAllEmpty then Result := FHashSysInfo else Result := FHashModules;
end;

function TModuleParser.ErrorToStr(Error: Integer): String;
begin
  case Error of
    ERR_PARSING: Result := 'Parsing error';
    ERR_UNK_MODULE: Result := 'Unknown module';
    ERR_UNK_ITEM: Result := 'Unknown item';
    ERR_MOD_INTERNAL: Result := 'Internal module error';
    ERR_INV_DB: Result := 'Unvalid database format';
  else
    Result := 'Unknown';
  end;
end;

{ TModule }

constructor TModule.Create(OutList: TList; M: TMemoryStream = nil);
begin
  OutList.Add(Self);
  FExecuted := False;
  FStream := M;
end;

function TModule.ReadData: TDataItem;
begin
  FStream.ReadBuffer(Result.cType, 4);
  FStream.ReadBuffer(Result.cSubtype, 4);
  FStream.ReadBuffer(Result.cbData, 4);
  SetLength(Result.Data, Result.cbData);
  FStream.ReadBuffer(Result.Data[1], Result.cbData);
end;

function TModule.HasMoreData: Boolean;
begin
  Result := FStream.Position < FStream.Size;
end;

function TModule.ReadNextDataType: TDataItem;
begin
  FStream.ReadBuffer(Result.cType, 4);
  FStream.ReadBuffer(Result.cSubtype, 4);
  FStream.Seek(-8, 1)
end;

procedure TModule.Run;
begin
  FExecuted := True;
  FStream.Seek(12, 0); // Skip header
end;

destructor TModule.Destroy;
begin
  FreeInputStream;
  inherited;
end;

procedure TModule.MoveIn;
var
  i: Integer;
begin
  if FCurNode^ <> nil then
    FCurNode^ := FCurNode^.GetLastChild
  else begin
    i := FTreeView.Items.Count;
    if i <> 0 then FCurNode^ := FTreeView.Items[i-1];
  end;
end;

procedure TModule.MoveOut;
begin
  if FCurNode^ <> nil then
    FCurNode^ := FCurNode^.Parent;
end;

procedure TModule.Append(const ItemName, Data: String; IconIndex: Integer);
var
  Node: TTreeNode;
  P: Pointer;
begin
  Node := FTreeView.Items.AddChild(FCurNode^, ItemName);

  //<img src="res://Parser2.exe/#2/ICON_BASE">
  GetMem(P, Length(Data)+1);
  StrPCopy(P, Data);
  Node.Data := P;
  Node.ImageIndex := IconIndex;
  Node.SelectedIndex := IconIndex;

  if (FShouldExpand) and (FCurNode^ <> nil) then begin
    FCurNode^.Expand(False);
    FShouldExpand := False;
    FCurNode^.Expanded := True;
  end;
end;

procedure TModule.Expand;
begin
  FShouldExpand := True;
end;

procedure TModule.ExportData(const Args: array of const);
var
  i, Len: Integer;
  S: String;
begin
  for i := Low(Args) to High(Args) do begin
    with Args[i] do begin
      FDBStream.WriteBuffer(VType, 1);
      case VType of
        vtInteger: FDBStream.WriteBuffer(VInteger, SizeOf(VInteger));
        vtBoolean: FDBStream.WriteBuffer(VBoolean, SizeOf(VBoolean));
        vtChar: FDBStream.WriteBuffer(VChar, SizeOf(VChar));
        vtExtended: FDBStream.WriteBuffer(VExtended^, SizeOf(VExtended^));
        vtInt64: FDBStream.WriteBuffer(VInt64^, SizeOf(VInt64^));
        vtAnsiString: begin
          S := String(VAnsiString);
          Len := Length(S);
          FDBStream.WriteBuffer(Len, 4);
          FDBStream.WriteBuffer(S[1], Len);
        end;
        vtVariant: begin
          S := String(VVariant^);
          Len := Length(S);
          FDBStream.WriteBuffer(Len, 4);
          FDBStream.WriteBuffer(S[1], Len);
        end;
        vtString: begin
          S := String(VString^);
          Len := Length(S);
          FDBStream.WriteBuffer(Len, 4);
          FDBStream.WriteBuffer(S[1], Len);
        end;
        vtPChar: begin
          S := String(VPChar);
          Len := Length(S);
          FDBStream.WriteBuffer(Len, 4);
          FDBStream.WriteBuffer(S[1], Len);
        end;
      end;
    end;
  end;
end;

function TModule.ImportData: Variant;
var
  VType: Byte;
  VLen: Integer;

  VInteger: Integer;
  VBoolean: Boolean;
  VChar: Byte;
  VExtended: Extended;
  VInt64: Int64;
  VString: String;
begin
  FDBStream.ReadBuffer(VType, 1);
  Result := varEmpty;
  case VType of
    vtInteger: begin
      FDBStream.ReadBuffer(VInteger, SizeOf(VInteger));
      Result := VInteger;
    end;
    vtBoolean: begin
      FDBStream.ReadBuffer(VBoolean, SizeOf(VBoolean));
      Result := VBoolean;
    end;
    vtChar: begin
      FDBStream.ReadBuffer(VChar, SizeOf(VChar));
      Result := VChar;
    end;
    vtExtended: begin
      FDBStream.ReadBuffer(VExtended, SizeOf(VExtended));
      Result := VExtended;
    end;
    vtInt64: begin
      FDBStream.ReadBuffer(VInt64, SizeOf(VInt64));
      Result := VInt64;
    end;
    vtAnsiString, vtString, vtPChar, vtVariant: begin
      FDBStream.ReadBuffer(VLen, 4);
      SetLength(VString, VLen);
      FDBStream.ReadBuffer(VString[1], VLen);
      Result := VString;
    end;
  end;
end;

procedure TModule.ExportModule(DBStream: TMemoryStream);
begin
  FDBStream := DBStream;
  ExportData([ModuleID]);
  ExportData([ModuleVersion]);
end;

procedure TModule.ImportModule(DBStream: TMemoryStream);
begin
  FDBStream := DBStream;
  FImportedID := ImportData; // ID
  FImportedVersion := ImportData; // Version
  FExecuted := True;
end;

procedure TModule.SetTreeView(TreeView: TTreeView);
begin
  if TreeView = nil then Exit;
  FTreeView := TreeView;
  FCurNode := Pointer(TreeView.Tag);
end;

procedure TModule.FreeInputStream;
begin
  if FStream <> nil then begin
    FStream.Free;
    FStream := nil;
  end;
end;

end.
