program execrypt;

{$APPTYPE CONSOLE}
//{$R execrypt.res}

uses
  windows;

var MyVirtualMem: integer;
    randf, sizememf, sizeresf: cardinal;

type TImportStruct = packed record
    res1,res2,res3,dllnameaddr,firstthunkaddr,
    res4,res5,res6,res7,res8: integer;
    f1,f2,f3,f4, f5: integer;
    s1: string[14];
    w1: word;
    s2: string[15];
    w2: word;
    s3: string[13];
    w3: word;
    s4: string[15];
    w4: word;
    s5: string[17];
    sizeres: cardinal;
    sizemem: cardinal;
    rand: cardinal;
  end;
    PByteArray = ^TByteArray;
    TByteArray = array[0..($FFFF shr 1)-1] of byte;
    TRC4Context = record
      D: array[Byte] of Byte;
      I,J: Byte;
    end;

var outfile: file of byte;

procedure OutWrite(p: pointer; s: integer);
begin
  BlockWrite(outfile,p^,s);
end;

function ExtractFileExt(const FileName: string): string;
var i, j, k: integer;
begin
  j := 1;
  for i := 1 to length(FileName) do
    if FileName[i] = '.' then j := i;
  k := 0;
  for i := j to length(FileName) do
    if FileName[i] = '\' then k := i;
  if k > 0 then result := '' else
    result := copy(FileName,j+1,length(FileName));
end;

procedure CreateHeader(pmem: pointer; smem: integer);
var IDH: PImageDosHeader;
    INH: PImageNtHeaders;
    SEC: PImageSectionHeader;
    i: integer;
    newmem: pointer;
    headersize: integer;
    secres, secressize: integer;
begin
  newmem := VirtualAlloc(nil,smem,MEM_COMMIT,PAGE_EXECUTE_READWRITE);
  CopyMemory(newmem,pmem,smem);
  IDH := newmem;
  if (IDH^.e_magic = IMAGE_DOS_SIGNATURE) then
  begin
    INH := pointer(cardinal(IDH)+cardinal(IDH^._lfanew));
    if (INH^.Signature = IMAGE_NT_SIGNATURE) then
    begin
      SEC := pointer(cardinal(INH)+cardinal(sizeof(TImageNtHeaders)));
      headersize := SEC^.PointerToRawData;
      secres := INH^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_RESOURCE].Size;
      secressize := INH^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_RESOURCE].Size;
      for i := 0 to INH^.FileHeader.NumberOfSections-1 do
      begin
        if (SEC^.VirtualAddress = INH^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_RESOURCE].VirtualAddress)
           and (INH^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_RESOURCE].VirtualAddress <> 0)  then
        begin
          SEC^.PointerToRawData := HeaderSize+$1000;
          secres := SEC^.Misc.VirtualSize;
          secressize := SEC^.SizeOfRawData;
          sizeresf := SEC^.SizeOfRawData;
        end else
        begin
          SEC^.SizeOfRawData := 0;
          SEC^.PointerToRawData := 0;
        end;
        SEC := pointer(integer(SEC)+sizeof(TImageSectionHeader));
      end;

      CopyMemory(@SEC^.Name,pchar('.ECRYPT'),8);
      SEC^.SizeOfRawData := $1000+cardinal(smem)+cardinal(secressize);
      MyVirtualMem := INH^.OptionalHeader.SizeOfImage;
      if MyVirtualMem mod $1000 <> 0 then
        MyVirtualMem := MyVirtualMem and $FFFFF000+$1000;
      SEC^.VirtualAddress := MyVirtualMem;
      SEC^.PointerToRawData := HeaderSize;
      SEC^.Misc.PhysicalAddress := MyVirtualMem;
      SEC^.Misc.VirtualSize := $1000+cardinal(smem)+cardinal(secres);
      if SEC^.Misc.VirtualSize mod $1000 <> 0 then
        SEC^.Misc.VirtualSize := SEC^.Misc.VirtualSize and $FFFFF000 + $1000;
      SEC^.Characteristics := $E0000040;

      INH^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT].VirtualAddress := MyVirtualMem;
      INH^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT].Size := $1000;
      INH^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_BASERELOC].VirtualAddress := 0;
      INH^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_BASERELOC].Size := 0;
      INH^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_BOUND_IMPORT].VirtualAddress := 0;
      INH^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_BOUND_IMPORT].Size := 0;

      INH^.OptionalHeader.BaseOfCode := MyVirtualMem;
      INH^.OptionalHeader.BaseOfData := MyVirtualMem;

      if INH^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_TLS].VirtualAddress <> 0 then
        INH^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_TLS].VirtualAddress := MyVirtualMem+SizeOf(TImportStruct);

      INH^.OptionalHeader.AddressOfEntryPoint := cardinal(MyVirtualMem)+SizeOf(TImportStruct)+
        INH^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_TLS].Size;
      INH^.FileHeader.NumberOfSections := INH^.FileHeader.NumberOfSections+1;
      INH^.OptionalHeader.SizeOfImage := INH^.OptionalHeader.SizeOfImage+SEC^.Misc.VirtualSize;
      OutWrite(newmem,headersize);
    end;
  end;
  VirtualFree(newmem,smem,MEM_DECOMMIT);
end;

procedure AddResourceSection(pmem: pointer);
var IDH: PImageDosHeader;
    INH: PImageNtHeaders;
    SEC: PImageSectionHeader;
    i: integer;
begin
  IDH := pmem;
  if (IDH^.e_magic = IMAGE_DOS_SIGNATURE) then
  begin
    INH := pointer(cardinal(IDH)+cardinal(IDH^._lfanew));
    if (INH^.Signature = IMAGE_NT_SIGNATURE) then
    begin
      if INH^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_RESOURCE].VirtualAddress <> 0 then
      begin
        SEC := pointer(cardinal(INH)+cardinal(sizeof(TImageNtHeaders)));
        for i := 0 to INH^.FileHeader.NumberOfSections-1 do
        begin
          if SEC^.VirtualAddress = INH^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_RESOURCE].VirtualAddress then
            OutWrite(pointer(cardinal(pmem)+SEC^.PointerToRawData),SEC^.SizeOfRawData);
          SEC := pointer(integer(SEC)+sizeof(TImageSectionHeader));
        end;
      end;
    end;
  end;
end;

function AddImport(p: pointer; mymem: integer): integer;
var ImportStruct: TImportStruct;
begin
  ZeroMemory(@ImportStruct,sizeof(TImportStruct));
  with ImportStruct do
  begin
    s1 := 'kernel32.dll';
    s2 := 'GetProcAddress';
    s3 := 'LoadLibraryA';
    s4 := 'VirtualProtect';
    s5 := 'GetModuleHandleA';
    dllnameaddr := MyVirtualMem+integer(@s1[1])-integer(@ImportStruct);
    firstthunkaddr := MyVirtualMem+integer(@f1)-integer(@ImportStruct);
    f1 := MyVirtualMem+integer(@w1)-integer(@ImportStruct)+1;
    f2 := MyVirtualMem+integer(@w2)-integer(@ImportStruct)+1;
    f3 := MyVirtualMem+integer(@w3)-integer(@ImportStruct)+1;
    f4 := MyVirtualMem+integer(@w4)-integer(@ImportStruct)+1;
    rand := randf;
    sizemem := sizememf;
    sizeres := sizeresf;
  end;
  CopyMemory(p,@ImportStruct,sizeof(TImportStruct));
  result := sizeOf(TImportStruct);
end;

function AddTls(pwr, fin: pointer): integer;
var IDH: PImageDosHeader;
    INH: PImageNtHeaders;
    SEC: PImageSectionHeader;
    i: integer;
begin
  IDH := fin;
  result := 0;
  if (IDH^.e_magic = IMAGE_DOS_SIGNATURE) then
  begin
    INH := pointer(cardinal(IDH)+cardinal(IDH^._lfanew));
    if (INH^.Signature = IMAGE_NT_SIGNATURE) then
    begin
      if INH^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_TLS].VirtualAddress = 0 then exit;
      SEC := pointer(cardinal(INH)+cardinal(sizeof(TImageNtHeaders)));
      for i := 0 to INH^.FileHeader.NumberOfSections-1 do
      begin
        if (SEC^.VirtualAddress <= INH^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_TLS].VirtualAddress) and
           (SEC^.VirtualAddress+SEC^.Misc.VirtualSize >= INH^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_TLS].VirtualAddress) then
        begin
          CopyMemory(pwr,
            pointer(cardinal(fin)+SEC^.PointerToRawData+
              INH^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_TLS].VirtualAddress-SEC^.VirtualAddress),
            INH^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_TLS].Size);
          result := INH^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_TLS].Size;
        end;
        SEC := pointer(integer(SEC)+sizeof(TImageSectionHeader));
      end;
    end;
  end;
end;

procedure AddCode(pwr: pointer; myaddr: integer);
  procedure main(fgmha, fvp, flla, fgpa: pointer); stdcall; forward;
  procedure getaddr; forward;
  procedure mydatabegin;
  asm
    call getaddr
    call main
  end;
  procedure getaddr;
  asm
    pop eax
    mov edx, eax
    and eax, $FFFFF000
    add eax, $28
    push eax
    push edx
    DB $0F DB $31
    MOV ECX, EAX
    MOV EBX, EDX
    DB $0F DB $31
    SUB EAX, ECX
    SUB EDX, EBX
    NEG EDX
    XOR EAX, EDX
    SHR EAX, 8
    MOV ECX, EAX
    pop edx
    pop eax
    dec eax
    lea eax, [eax+1+ecx]
    push [eax]
    lea eax, [eax+4+ecx]
    push [eax]
    lea eax, [eax+4+ecx]
    push [eax]
    lea eax, [eax+4+ecx]
    push [eax]
    push edx
  end;
  procedure main(fgmha, fvp, flla, fgpa: pointer); stdcall;
  var myGetProcAddress: function(hModule: HMODULE; lpProcName: LPCSTR): FARPROC; stdcall;
      myLoadLibraryA: function(lpLibFileName: PChar): HMODULE; stdcall;
      myVirtualProtect: function(lpAddress: Pointer; dwSize, flNewProtect: DWORD; var lpflOldProtect: DWORD): BOOL; stdcall;
      myGetModuleHandleA: function(lpModuleName: PAnsiChar): HMODULE; stdcall;

      IDH: PImageDosHeader;
      INH: PImageNtHeaders;
      SEC: PImageSectionHeader;
      i: integer;
      memb, mems: cardinal;
      old, ep, base: cardinal;

      procedure RC4Init(var RC4: TRC4Context; Key: pointer; LenKey: cardinal); overload;
      var
        R,S,T,K: Byte;
        U,L: Integer;
      begin
        L := LenKey;
        with RC4 do
        begin
          I := 0;
          J := 0;
          for S := 0 to 255 do D[S] := S;
          R := 0;
          U := 0;
          for S := 0 to 255 do
          begin
            if U < L then K := PByteArray(Key)[U] else K := 0;
            Inc(U);
            if U >= L then U := 0;

            Inc(R, D[S] + K);
            T    := D[S];
            D[S] := D[R];
            D[R] := T;
          end;
        end;
      end;

      procedure RC4Code(var RC4: TRC4Context; const Source; var Dest; Count: Integer); overload;
      var
        S: Integer;
        T: Byte;
      begin
        with RC4 do
          for S := 0 to Count -1 do
          begin
            Inc(I);
            T := D[I];
            Inc(J, T);
            D[I] := D[J];
            D[J] := T;
            Inc(T, D[I]);
            TByteArray(Dest)[S] := TByteArray(Source)[S] xor D[T];
          end;
      end;
      procedure RC4CodeMem(value: pointer; password: pointer; lenvalue, lenpw: cardinal); overload;
      var
        RC4: TRC4Context;
      begin
        RC4Init(RC4, password,lenpw);
        RC4Code(RC4, value^, value^,lenvalue);
      end;

      procedure myCopyMemory(p1,p2: pointer; s: integer);
      var i: integer;
      begin
        for i := 0 to s-1 do
          pbyte(integer(p1)+i)^ := pbyte(integer(p2)+i)^;
      end;

  procedure CreateImportTable(dllbasep, importp: pointer); stdcall;
  type timportblock = record
                        Characteristics: cardinal;
                        TimeDateStamp: cardinal;
                        ForwarderChain: cardinal;
                        Name: pchar;
                        FirstThunk: pointer;
                      end;
       pimportblock = ^timportblock;
  var myimport: pimportblock;
      thunksread, thunkswrite: ^pointer;
      dllname: pchar;
      dllh: thandle;
      old: cardinal;
  begin
    myimport := importp;
    while (myimport^.FirstThunk <> nil) and (myimport^.Name <> nil) do
    begin
      dllname := pointer(integer(dllbasep)+integer(myimport^.name));
      dllh := myLoadLibraryA(dllname);
      thunksread := pointer(integer(myimport^.FirstThunk)+integer(dllbasep));
      thunkswrite := thunksread;
      if integer(myimport^.TimeDateStamp) = -1 then
        thunksread := pointer(integer(myimport^.Characteristics)+integer(dllbasep));
      while (thunksread^ <> nil) do
      begin
        if myVirtualProtect(thunkswrite,4,PAGE_EXECUTE_READWRITE,old) then
        begin
          if (cardinal(thunksread^) and  $80000000 <> 0) then
            thunkswrite^ := myGetProcAddress(dllh,pchar(cardinal(thunksread^) and $FFFF)) else
            thunkswrite^ := myGetProcAddress(dllh,pchar(integer(dllbasep)+integer(thunksread^)+2));
          myVirtualProtect(thunkswrite,4,old,old);
        end;
        inc(thunksread,1);
        inc(thunkswrite,1);
      end;
      myimport := pointer(integer(myimport)+sizeof(timportblock));
    end;
  end;
  begin
    @myGetProcAddress := fgpa;
    @myLoadLibraryA := flla;
    @myVirtualProtect := fvp;
    @myGetModuleHandleA := fgmha;
    base := myGetModuleHandleA(nil);
    IDH := pointer(base);
    if (IDH^.e_magic = IMAGE_DOS_SIGNATURE) then
    begin
      INH := pointer(cardinal(IDH)+cardinal(IDH^._lfanew));
      if (INH^.Signature = IMAGE_NT_SIGNATURE) then
      begin
        mems := pcardinal(INH^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT].VirtualAddress+base
          + sizeOf(TimportStruct)-8)^;
        memb := cardinal(base)+INH^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT].VirtualAddress+$1000+
          pcardinal(INH^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT].VirtualAddress+base
          + sizeOf(TimportStruct)-12)^;

        myVirtualProtect(pointer(INH^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT].VirtualAddress+base),
                                 mems,
                                 PAGE_EXECUTE_READWRITE,old);
        RC4CodeMem(pointer(memb),
          pointer(INH^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT].VirtualAddress+base
          + sizeOf(TimportStruct)-4),mems,4);
        myVirtualProtect(pointer(INH^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT].VirtualAddress+base),
                                 mems,
                                 old,old);

        IDH := pointer(memb);
        if (IDH^.e_magic = IMAGE_DOS_SIGNATURE) then
        begin
          INH := pointer(cardinal(IDH)+cardinal(IDH^._lfanew));
          if (INH^.Signature = IMAGE_NT_SIGNATURE) then
          begin
            SEC := pointer(cardinal(INH)+cardinal(sizeof(TImageNtHeaders)));
            for i := 0 to INH^.FileHeader.NumberOfSections-1 do
            begin
              myVirtualProtect(pointer(SEC^.VirtualAddress+base),SEC^.SizeOfRawData,PAGE_EXECUTE_READWRITE,old);
              myCopyMemory(pointer(SEC^.VirtualAddress+base),pointer(cardinal(memb)+SEC^.PointerToRawData),SEC^.SizeOfRawData);
              myVirtualProtect(pointer(SEC^.VirtualAddress+base),SEC^.SizeOfRawData,old,old);
              SEC := pointer(integer(SEC)+sizeof(TImageSectionHeader));
            end;
            if (INH^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT].VirtualAddress <> 0) and
               (INH^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT].Size <> 0) then
            begin
              myVirtualProtect(pointer(INH^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT].VirtualAddress+base),
                                       INH^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT].Size,
                                       PAGE_EXECUTE_READWRITE,old);
              CreateImportTable(pointer(base),pointer(INH^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT].VirtualAddress+base));
              myVirtualProtect(pointer(INH^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT].VirtualAddress+base),
                                       INH^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT].Size,
                                       old,old);
            end;
            ep := INH^.OptionalHeader.AddressOfEntryPoint+base;
            asm
              jmp ep
            end;
          end;
        end;
      end;
    end;
  end;
  procedure mydataend; asm end;
begin
  CopyMemory(pwr,@mydatabegin,integer(@mydataend)-integer(@mydatabegin));
end;

procedure AddCodeSection(fin: pointer);
var p, newadd: pointer;
begin
  p := VirtualAlloc(nil,$1000,MEM_COMMIT,PAGE_EXECUTE_READWRITE);
  newadd := p;

  newadd := pointer(integer(newadd)+AddImport(newadd, MyVirtualMem));
  newadd := pointer(integer(newadd)+AddTls(newadd, fin));

  AddCode(newadd, MyVirtualMem);

  OutWrite(p,$1000);
  VirtualFree(p,$1000,MEM_DECOMMIT);
end;

procedure RC4Init(var RC4: TRC4Context; Key: pointer; LenKey: cardinal); overload;
var
  R,S,T,K: Byte;
  U,L: Integer;
begin
  L := LenKey;
  with RC4 do
  begin
    I := 0;
    J := 0;
    for S := 0 to 255 do D[S] := S;
    R := 0;
    U := 0;
    for S := 0 to 255 do
    begin
      if U < L then K := PByteArray(Key)[U] else K := 0;
      Inc(U);
      if U >= L then U := 0;

      Inc(R, D[S] + K);
      T    := D[S];
      D[S] := D[R];
      D[R] := T;
    end;
  end;
end;

procedure RC4Code(var RC4: TRC4Context; const Source; var Dest; Count: Integer); overload;
var
  S: Integer;
  T: Byte;
begin
  with RC4 do
    for S := 0 to Count -1 do
    begin
      Inc(I);
      T := D[I];
      Inc(J, T);
      D[I] := D[J];
      D[J] := T;
      Inc(T, D[I]);
      TByteArray(Dest)[S] := TByteArray(Source)[S] xor D[T];
    end;
end;


procedure RC4Done(var RC4: TRC4Context);
begin
  FillChar(RC4, SizeOf(RC4), 0);
end;

procedure RC4CodeMem(value: pointer; password: pointer; lenvalue, lenpw: cardinal); overload;
var
  RC4: TRC4Context;
begin
  RC4Init(RC4, password,lenpw);
  RC4Code(RC4, value^, value^,lenvalue);
  RC4Done(RC4);
end;


function FileExists(s: string): boolean;
var f: file;
begin
  result := true;
  assignfile(f,s);
  try
    reset(f);
  except
    result := false;
  end;
  closefile(f);
end;

procedure FileLoad(s: string; var p: pointer; var size: integer);
var f: file of byte;
begin
  AssignFile(f,s);
  Reset(f);
  size := FileSize(f);
  p := virtualalloc(nil,size,MEM_COMMIT,PAGE_EXECUTE_READWRITE);
  BlockRead(f,p^,size);
  CloseFile(f);
end;


var //fileout: tfilestream;
    fileinpointer: pointer;
    filen, filen2: string;
    fileinsize: integer;
begin
  randomize;
  randf := random(high(cardinal));
  writeln('---------------------------');
  writeln('|  Execrypt v 1.3 by uall  |');
  writeln('---------------------------');
  writeln('');
  if (paramcount > 0) then
  begin
    filen := paramstr(1);
    if FileExists(filen) then
    begin
      writeln('crypting: ',filen);
      FileLoad(filen,fileinpointer,fileinsize);
      filen2 := filen;
      insert(' crypted',filen2,length(filen2)-length(ExtractFileExt(filen2)));

      sizememf := fileinsize;
      AssignFile(outfile,filen2);
      Rewrite(outfile);
      CreateHeader(fileinpointer,fileinsize);
      AddCodeSection(fileinpointer);
      AddResourceSection(fileinpointer);
      RC4CodeMem(fileinpointer,@randf,fileinsize,4);

      OutWrite(fileinpointer,fileinsize);
      CloseFile(outfile);

      writeln('saved to: ',filen2);
    end else
      writeln('file does not exists or not readable');
  end else
  begin
    writeln('no file selected');
    writeln('ex.: C:\execrypt.exe "D:\file\to\be\crypted\here.exe"');
  end;
  readln;
end.