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
    mov ebx, esp
    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;
      desp: 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 DecompressHuff(p1,p2: pointer; len: integer);  stdcall;
        procedure myCopyMemory(toaddr,fromaddr: pointer; size: integer); stdcall;
        var i: integer;
        begin
          for i := 0 to size-1 do
            pbyte(integer(toaddr)+i)^ := pbyte(integer(fromaddr)+i)^;
        end;

        procedure myZeroMemory(p: pointer; l: integer); stdcall;
        var i: integer;
        begin
          for i := 0 to l-1 do
            pbyte(integer(p)+i)^ := 0;
        end;

      type
        Phuffinfo = ^Thuffinfo;
        THuffInfo = record
          left: phuffinfo;
          right: phuffinfo;
          code: array[0..255] of byte;
          codecount: integer;
          huff, char:byte;
          freq: integer;
          ticked: boolean;
        end;
        THuffcode = record
          char: byte;
          used: boolean;
          code: array[0..255] of byte;
          codelength: integer;
        end;
        PhuffCode=^THuffCode;


      var
        table: array[0..1495] of byte;
        charlist:array[0..511] of THuffinfo;
        huffcodes: array[0..255] of Thuffcode;
        tabsize: integer;

        i: integer;
        endbits: integer;

        procedure RetrieveTable(pin: pointer); stdcall;
        var
          j, k, l: integer;
          index: integer;
          length, cnt: integer;
          tmpcode: byte;
        begin
          endbits := pbyte(integer(pin))^;
          if endbits = 0 then endbits := 8;
          pin := pointer(integer(pin)+1);
          myCopyMemory(@table,pin,sizeof(table));
          tabsize := pinteger(@table[0])^;
          k := sizeof(tabsize);
          while k < tabsize + sizeof(tabsize) do
          begin
            j := 0;
            index := table[k];
            inc(k);
            length := table[k];
            inc(k);
            huffcodes[index].used := true;
            huffcodes[index].char := index;
            huffcodes[index].codelength := length;
            while j <= length-1 do
            begin
              tmpcode := table[k];
              inc(k);
              if (length-j) > 8 then cnt := 8 else cnt := length-j;
              for l := 1 to cnt do
                huffcodes[index].code[l+j-1]:=(tmpcode shr (8-l)) and 1;
              j := j + cnt;
            end;
          end;
        end;

        procedure ReconstructTree; stdcall;
        var
          rinfo: phuffinfo;
          i,j,k: integer;
        begin
         k := 0;
         myZeroMemory(@charlist,sizeof(charlist));
         for i := 0 to 255 do
         begin
           rinfo := @charlist[511];
           for j := 0 to huffcodes[i].codelength-1 do
           begin
             charlist[k].huff := huffcodes[i].code[j];
             if huffcodes[i].code[j]= 0 then
             begin
               if rinfo.left = nil then
               begin
                 rinfo.left := @charlist[k];
                 inc(k);
               end;
               rinfo := rinfo.left;
             end else
             begin
               if rinfo.right=nil then
               begin
                 rinfo.right := @charlist[k];
                 inc(k);
               end;
               rinfo := rinfo.right;
             end;
             if j = huffcodes[i].codelength-1 then
              rinfo.char:=huffcodes[i].char;
            end;
          end;
        end;

        procedure WriteUncompressedFile(pin, pout: pointer; len: integer); stdcall;
        var
          i, j, l: integer;
          tmpbit, tmpbyte: byte;
          tmpnode: phuffinfo;
        begin
          i := 1;
          j := 1;
          l := 0;
          tmpnode := @charlist[511];
          pin := pointer(integer(pin)+tabsize+sizeof(tabsize)+1);
          tmpbyte := pbyte(integer(pin))^;
          while true do
          begin
            while (tmpnode.left <> nil) do
            begin
              if (j > 8) then
              begin
                tmpbyte := pbyte(integer(pin)+i)^;
                inc(i);
                j := 1;
              end;
              tmpbit := (tmpbyte shr (8-j)) and 1;
              if tmpnode.left.huff = tmpbit then
                tmpnode := tmpnode.left else
                tmpnode := tmpnode.right;
              inc(j);
            end;
            pbyte(integer(pout)+l)^ := tmpnode.char;
            inc(l);
            tmpnode := @charlist[511];
            if (i = len) then exit;
          end;
        end;
      begin
        // init
        myZeromemory(@table,sizeof(table));
        myZeroMemory(@charlist,sizeof(charlist));
        myZeroMemory(@huffcodes,sizeof(huffcodes));
        for i := 0 to 255 do
        begin
          charlist[i].code[charlist[i].codecount]:=i;
          inc(charlist[i].codecount);
        end;
        RetrieveTable(p1);
        ReconstructTree;
        WriteUncompressedFile(p1,p2,len);
      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
    asm
      mov desp, ebx
    end;
    @myGetProcAddress := fgpa;
    @myLoadLibraryA := flla;
    @myVirtualProtect := fvp;
    @myGetModuleHandleA := fgmha;
    base := myGetModuleHandleA(nil);
    if pcardinal(desp+8)^ = 1 then
    base := pcardinal(desp+4)^;
    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
              mov esp, desp
              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;

function CompressHuff(p1, p2: pointer; len: integer): integer; stdcall;
  procedure myZeroMemory(p: pointer; l: integer);
  var i: integer;
  begin
    for i := 0 to l-1 do
      pbyte(integer(p)+i)^ := 0;
  end;

type
  Phuffinfo = ^Thuffinfo;
  THuffInfo = record
    left: phuffinfo;
    right: phuffinfo;
    code: array[0..255] of byte;
    codecount: integer;
    huff, char:byte;
    freq: integer;
    ticked: boolean;
  end;
  THuffcode = record
    char: byte;
    used: boolean;
    code: array[0..255] of byte;
    codelength: integer;
  end;
  PhuffCode=^THuffCode;


var
  rootnode: Phuffinfo;
  table: array[0..1495] of byte;
  charlist:array[0..511] of THuffinfo;
  huffcodes: array[0..255] of Thuffcode;
  tabsize: integer;

  i: integer;

  function StrCopy(Dest: PChar; const Source: PChar): PChar;
  asm
          PUSH    EDI
          PUSH    ESI
          MOV     ESI,EAX
          MOV     EDI,EDX
          MOV     ECX,0FFFFFFFFH
          XOR     AL,AL
          REPNE   SCASB
          NOT     ECX
          MOV     EDI,ESI
          MOV     ESI,EDX
          MOV     EDX,ECX
          MOV     EAX,EDI
          SHR     ECX,2
          REP     MOVSD
          MOV     ECX,EDX
          AND     ECX,3
          REP     MOVSB
          POP     ESI
          POP     EDI
  end;

  function StrEnd(const Str: PChar): PChar; assembler;
  asm
          MOV     EDX,EDI
          MOV     EDI,EAX
          MOV     ECX,0FFFFFFFFH
          XOR     AL,AL
          REPNE   SCASB
          LEA     EAX,[EDI-1]
          MOV     EDI,EDX
  end;


  procedure BuildTree; stdcall;
  var
    i, cnt, tmp:integer;
    pinfo1, pinfo2:Phuffinfo;
  begin
    pinfo1 := nil;
    pinfo2 := nil;
    cnt := 255;
    while true do
    begin
      tmp :=maxint;
      for i:=0 to cnt do
      begin
        if (charlist[i].freq < tmp) and (charlist[i].freq > 0) and(charlist[i].ticked = false) then
        begin
          pinfo1 := @charlist[i];
          tmp := pinfo1.freq;
        end;
      end;
      if pinfo1 = nil then break;
      pinfo1.ticked := true;
      tmp := maxint;
      for i := 0 to cnt do
      begin
        if (charlist[i].freq < tmp) and (charlist[i].freq > 0) and (charlist[i].ticked = false) then
        begin
          pinfo2:=@charlist[i];
          tmp:=pinfo2.freq;
        end;
      end;
      if pinfo2 = nil then break;
      pinfo2.ticked := true;
      inc(cnt);
      charlist[cnt].freq := pinfo1.freq+pinfo2.freq;
      strcopy(StrEnd(@charlist[cnt].code),@pinfo1.code);
      strcopy(StrEnd(@charlist[cnt].code),@pinfo2.code);
      charlist[cnt].codecount := pinfo1.codecount+pinfo2.codecount;
      charlist[cnt].left := pinfo1;
      charlist[cnt].right := pinfo2;
      pinfo1 := nil;
      pinfo2 := nil;
    end;
    rootnode := @charlist[cnt];
  end;


  procedure GetCodes; stdcall;
  var
    i, j: integer;
    tmpnode: phuffinfo;
    flag: integer;
  begin
    for i := 0 to 255 do
    begin
      flag := -1;
      tmpnode := rootnode;
      while tmpnode.left <> nil do
      begin
        for j := 0 to tmpnode.left.codecount-1 do
        if tmpnode.left.code[j] = i then
        begin
          flag := 0;
          tmpnode := tmpnode.left;
          break;
        end;
        if flag = -1 then
        begin
          for j := 0 to tmpnode.right.codecount-1 do
          if tmpnode.right.code[j] = i then
          begin
            flag := 1;
            tmpnode := tmpnode.right;
            break;
          end;
        end;
        if flag = -1 then break;
        huffcodes[i].used := true;
        huffcodes[i].code[huffcodes[i].codelength] := flag;
        huffcodes[i].codelength := huffcodes[i].codelength+1;
        huffcodes[i].char := i;
        flag := -1;
      end;
    end;
  end;

  procedure GetTable; stdcall;
  var
    i,j,k:integer;
    tmpcode:byte;
    bit:integer;
  begin
    k := 0;
    bit := 0;
    tmpcode := 0;
    for i := 0 to 255 do
    begin
      if huffcodes[i].used = false then continue;
      table[k] := i;
      table[k+1] := huffcodes[i].codelength;
      k := k+2;
      for j := 0 to huffcodes[i].codelength-1 do
      begin
        tmpcode:=tmpcode shl 1 or huffcodes[i].code[j];
        bit := bit+1;
        if bit=8 then
        begin
          table[k]:= tmpcode;
          k := k+1;
          bit := 0;
          tmpcode := 0;
        end;
      end;
      if bit > 0 then
      begin
        tmpcode := tmpcode shl (8-bit);
        table[k] := tmpcode;
        k := k+1;
        bit := 0;
        tmpcode := 0;
      end;
    end;
    tabsize := k;
  end;

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

  procedure WriteCompressedData(pin, pout: pointer; len: integer); stdcall;
  var
    i, j, k: integer;
    tmpcode: byte;
    bit: integer;
    spout: pointer;
  begin
    spout := pout;
    pout := pointer(integer(pout)+1);
    k := 0;
    tmpcode := 0;
    bit := 0;
    myCopyMemory(pout, @tabsize, sizeof(tabsize));
    pout := pointer(integer(pout)+sizeof(tabsize));

    myCopyMemory(pout, @table, tabsize);
    pout := pointer(integer(pout)+tabsize);

    for i := 0 to len-1 do
    begin
      for j := 0 to huffcodes[pbyte(integer(pin)+i)^].codelength-1 do
      begin
        tmpcode := (tmpcode shl 1) or huffcodes[pbyte(integer(pin)+i)^].code[j];
        inc(bit);
        if bit = 8 then
        begin
          pbyte(integer(pout)+k)^ := tmpcode;
          inc(k);
          bit := 0;
          tmpcode := 0;
        end;
      end;
    end;

    if bit > 0 then
    begin
      tmpcode := tmpcode shl (8-bit);
      pbyte(integer(pout)+k)^ := tmpcode;
      inc(k);
    end;
    if k > 0 then
      pbyte(integer(pout)+k)^ := k;
    pbyte(integer(spout))^ := bit;
  end;

  function GetCompressedSize: integer; stdcall;
  var
    i, cfilesize: integer;
  begin
    result := 0;
    for i := 0 to 255 do
    begin
      if huffcodes[i].used then
        result := result + huffcodes[i].codelength * charlist[i].freq;
    end;
    cfilesize := result div 8;
    if result mod 8 > 0 then cfilesize := cfilesize + 1;
    cfilesize := cfilesize+tabsize+sizeof(tabsize) + 1;
    result := cfilesize;
  end;

begin
  // init
  rootnode := nil;
  myZeromemory(@table,sizeof(table));
  myZeroMemory(@charlist,sizeof(charlist));
  myZeroMemory(@huffcodes,sizeof(huffcodes));
  for i := 0 to 255 do
  begin
    charlist[i].code[charlist[i].codecount]:=i;
    inc(charlist[i].codecount);
  end;

  // charcount
  for i := 0 to len-1 do
    charlist[pbyte(integer(p1)+i)^].freq := charlist[pbyte(integer(p1)+i)^].freq+1;

  BuildTree;
  GetCodes;
  GetTable;
  WriteCompressedData(p1, p2, len);
  result := GetCompressedSize;
end;

var //fileout: tfilestream;
    fileinpointer: pointer;
    filen, filen2: string;
    fileinsize: integer;
begin
  randomize;
  randf := random(high(cardinal));
  writeln('---------------------------');
  writeln('|  Execrypt v 1.4 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.