(*$Alignrec-*)
unit reskonv; (* Convert Resource(tree)s *)

interface

uses pe2lety;

procedure konvertiere_resourcen(
  const quelle                  :pointer;
  const quell_laenge,quell_rva  :longint;
  var   ziel                    :speicherfeld_z_typ;
  var   ziel_laenge             :longint);

implementation

type

  RESOURCE_DIR_ENTRIES_typ=
    record
      NAME_RVA_or_INTEGER_ID    :longint;
      DATA_ENTRY_RVA_or_SUBDIR_RVA:longint; (* Bit 31=1 -> Subdir *)
    end;

  Resource_Directory_Table_typ=
    record
      RESOURCE_FLAGS            :longint;
      TIME_DATE_STAMP           :longint;
      MAJOR_VERSION             :smallword;
      MINOR_VERSION             :smallword;
      number_of_NAME_ENTRY      :smallword;
      number_of_ID_ENTRY        :smallword;
      RESOURCE_DIR_ENTRIES      :array[1..100000] of RESOURCE_DIR_ENTRIES_typ;
    end;

  Resource_Directory_Table_z_typ=^Resource_Directory_Table_typ;

  Resource_Data_Entry=
    record
      DATA_RVA                  :longint;
      SIZE                      :longint;
      CODEPAGE                  :longint;
      RESERVED                  :longint;
    end;

  Resource_Data_Entry_z_typ     =^Resource_Data_Entry;


procedure konvertiere_resourcen(
  const quelle                  :pointer;
  const quell_laenge,quell_rva  :longint;
  var   ziel                    :speicherfeld_z_typ;
  var   ziel_laenge             :longint);


  procedure schreibe(var a;laenge:longint);
    begin
      Move(a,Mem[ofs(ziel^)+ziel_laenge],laenge);
      Inc(ziel_laenge,laenge);
    end;

  var
    resource_typid,
    resource_nameid             :smallword;

    d32_reso_kopf:
      record
        reso_laenge             :longint;
        reso_typ,reso_id        :smallword;
      end;

  procedure kopiere_resourcen(const r:Resource_Data_Entry_z_typ);
    var
      weiter                    :pointer;
      zaehler,
      string_laenge,
      lese_position,
      schreib_position          :longint;
      temp                      :array[0..16*8000] of byte;
    begin
      weiter:=ptr(ofs(quelle^)+r.DATA_RVA-quell_rva);
      d32_reso_kopf.reso_id:=resource_nameid;

      if resource_typid=6 (* StringTable *) then
        begin
          d32_reso_kopf.reso_typ:=0;  (* StringTable *)
          dec(d32_reso_kopf.reso_id); (* $ff80 -> $0ff9 -> $0ff8 *)

          lese_position:=ofs(weiter^);
          schreib_position:=0;

          for zaehler:=0 to 15 do
            begin
              string_laenge:=memw[lese_position];
              inc(lese_position,2);
              temp[schreib_position]:=lo(string_laenge);
              inc(schreib_position);
              temp[schreib_position]:=hi(string_laenge);
              inc(schreib_position);

              (*write(d32_reso_kopf.reso_id*16+zaehler,', "');*)

              while string_laenge>0 do
                begin
                  temp[schreib_position]:=mem[lese_position];
                  (*write(chr(mem[lese_position]));*)
                  inc(lese_position,2);
                  inc(schreib_position);
                  dec(string_laenge);
                end;

              (*writeln('"');*)

            end;
          d32_reso_kopf.reso_laenge:=sizeof(d32_reso_kopf)+schreib_position;
          schreibe(d32_reso_kopf,sizeof(d32_reso_kopf));
          schreibe(temp,schreib_position);
        end
      else
        begin
          d32_reso_kopf.reso_typ:=1; (* binary *)
          d32_reso_kopf.reso_laenge:=r.size+sizeof(d32_reso_kopf);
          schreibe(d32_reso_kopf,sizeof(d32_reso_kopf));
          schreibe(weiter^,r.size);
        end;
    end;

  procedure Language_baum(const l:Resource_Directory_Table_z_typ);
    var
      zaehler                   :longint;
      weiter                    :pointer;
    begin
      with l^ do
        for zaehler:=1 to number_of_ID_ENTRY do
          with RESOURCE_DIR_ENTRIES[zaehler] do
            begin
              if NAME_RVA_or_INTEGER_ID<>0 then
                writeln('warning: no multilanguage support!');
              weiter:=ptr(ofs(quelle^)+(DATA_ENTRY_RVA_or_SUBDIR_RVA and $7fffffff));
              if (DATA_ENTRY_RVA_or_SUBDIR_RVA and $80000000)=0 then
                kopiere_resourcen(Resource_Data_Entry_z_typ(weiter))
              else
                Language_baum(Resource_Directory_Table_z_typ(weiter));
            end;
    end;

  procedure NameId_baum(const l:Resource_Directory_Table_z_typ);
    var
      zaehler                   :longint;
      weiter                    :pointer;
    begin
      with l^ do
        for zaehler:=1 to number_of_ID_ENTRY do
          with RESOURCE_DIR_ENTRIES[zaehler] do
            begin
              resource_nameid:=NAME_RVA_or_INTEGER_ID;
              weiter:=ptr(ofs(quelle^)+(DATA_ENTRY_RVA_or_SUBDIR_RVA and $7fffffff));
              if (DATA_ENTRY_RVA_or_SUBDIR_RVA and $80000000)=0 then
                kopiere_resourcen(Resource_Data_Entry_z_typ(weiter))
              else
                Language_baum(Resource_Directory_Table_z_typ(weiter));
            end;
    end;

  procedure TypeId_baum(const l:Resource_Directory_Table_z_typ);
    var
      zaehler                   :longint;
      weiter                    :pointer;
    begin
      with l^ do
        for zaehler:=1 to number_of_ID_ENTRY do
          with RESOURCE_DIR_ENTRIES[zaehler] do
            begin
              resource_typid :=NAME_RVA_or_INTEGER_ID;
              resource_nameid:=0;
              weiter:=ptr(ofs(quelle^)+(DATA_ENTRY_RVA_or_SUBDIR_RVA and $7fffffff));
              if (DATA_ENTRY_RVA_or_SUBDIR_RVA and $80000000)=0 then
                kopiere_resourcen(Resource_Data_Entry_z_typ(weiter))
              else
                NameId_baum(Resource_Directory_Table_z_typ(weiter));
            end;
    end;


  begin
    TypeId_baum(Resource_Directory_Table_z_typ(quelle));
  end;

end.

