{$F+}
{$IFDEF FPC}uses Go32;{$ENDIF}
Function Check_UPX(vstup:pointer):longint;
var s:pchar;
    a,b:word;

begin
Check_UPX:=-1;
s:=vstup;
if (byte(s[0])<>$81) or (byte(s[1])<>$fc) then Exit;
{Zacatek UPX-ovaneho souboru je:
cmp sp,0x100+dekomp_code_size+dekompr_size+stacksize //zhruba 0x200+dekomp_code_size
ja @EnoughRam      //dost pameti? tak pojracuj dale
int 20h            //pokud bylo pameti malo, tak skonci
@EnoughRam
//a zde neco jako "kopiruj dekompresor a kod na konec segmentu"
//a pak zahlavi UPX
//binarne je to takto: "81  fc  xx  xx  77  02  cd  20 ..."
                       s[0] [1] [2] [3] [4] [5] [6] [7]
}

for a:=4 to 255 do
{Od s[4] dale hledame retezec "UPX!"}
    if (s[a]='U') and (s[a+1]='P') and (s[a+2]='X') and (s[a+3]='!') then
       begin
       if byte(s[a+4])<10 then Exit; {prilis stara verze UPX?}
       Check_UPX:=a;
       Exit;
       end;
end;

{$IFNDEF FPC}
Procedure Skok_Do_COM_souboru(vstup:pointer;vel_orig,vel_dekomp:word;savebyte:byte);
var calladd:pointer;
begin
asm
push es
push ds
push si
push di

lds si,vstup               {DS = segm. vstup,  SI = ofs. vstup}
{predpoklada, ze SI = 0}

mov ax,ds
sub ax,10h         {od segmentove casti assdresy odecteme 16}

mov si,100h        {aby dekompresor spravne fungoval, tak kod musi byt}
                   {od offsetu 100h (tak jako zacinaji .COM soubory)}

lea di,calladd
push ss
pop es             {v ES:DI mam adresu CallAdd}

mov es:[di],si     {napred offset}
mov es:[di+2],ax   {ted segment}

mov ds,ax
mov es,ax          {DS=ES=AX}

push sp
push bp

call calladd       {dekomprimuje UPX a spusti instrukci RETF (kterou jsme}
                   {predtim vlozili druhou modifikaci}

pop bp
pop sp

lds si,vstup
mov al,savebyte
mov ds:[si],al     {obnovime 1.bajt na FF}

pop di
pop si
pop ds
pop es
end;
end;

{$ELSE}
Procedure Skok_Do_COM_souboru(vstup:pointer;vel_orig,vel_dekomp:word;savebyte:byte);
var konvbuf:longint;
    realsegm:word;
    regs:TRealRegs;
begin
konvbuf:=Global_DOS_Alloc(65535);
realsegm:=Word(konvbuf shr 16);
DOSMemPut(realsegm,0,vstup^,vel_orig);
FillChar(regs,sizeof(TRealRegs),0);

regs.ds:=realsegm-$10;
regs.es:=regs.ds;
regs.si:=$100;
regs.cs:=regs.ds;
regs.ip:=$100;

asm
mov eax,0301h
xor ecx, ecx
xor ebx,ebx
lea edi,regs
int 31h         {Funkce INT31h/301h (CallRealModeFarRoutine)}
end;

DosMemGet(realsegm,0,vstup^,vel_dekomp);
Global_DOS_Free(word(konvbuf));
pchar(vstup)^:=char(savebyte);
end;
{$ENDIF}


Function Decode_UPX(vstup:pointer;vel_orig:word):word;
{originalni kod chce, aby adresa bufferu VSTUP byla normalizovana, t.j. aby
 offset byl 0}
var a:longint;
    vel_dekomp:word;
    s:pchar;
    savebyte:byte;

begin
a:=Check_UPX(vstup);
if a=-1 then begin Decode_UPX:=0;Exit;end;

s:=vstup;

byte(s[4]):=$eb;    {1. modifikace - test dostatku pameti: zmenime, aby}
                    {to vzdycky vyslo, t.j. podm. skok zmenim na nepodmineny}

savebyte:=byte(s[a+6+16+2]);  {tento bajt budeme menit, zapomatujeme ho pro obnovu}
byte(s[a+6+16+2]):=$cb; {2. modifikace - vsadim opcode pro RETF, aby se}
                        {nezpoustel radoby COM soubor}
vel_dekomp:=word((byte(s[a+16])+word(s[a+17])*256));

{V originalnim kodu ted nasleduje kontrola wordu na s[25], jestli tam jsou
bajty "FO" (jako FONT), ale to vypustime, jelikoz tvorime univerzalni
dekompresor.}


{Jeste prekopiruju popis hlavicky UPX komprimovaneho .COM souboru:}
{Zahlavi zacina retezcem UPX! a pro verze 1.<neco> plati toto:
[04] verze (napr. 0B)
[05] format (1 pro .COM)
[06] metoda (melo by zde byt 4)
[07] uroven komprese (melo by byt 8)
[08] adler32u - kontr. soucet nekomprimovanych dat (dword)
[0C] adler32c - kontr. soucet komprimovanych dat (dword)
[10] sizeu - velikost nekomprimovanych dat (word)
[12] sizec - veliksot komprimovanych dat (word)
[14] "filter"
[15] kontr. soucet zahlavi
[16] komrimovana data...

Pokud je verze pod 0A, tak ma pro .COM zahlavi 20 bajtu (misto 22 bajtu).
A pokud je verze pod 03, tak je to 24 bajtu.
Ale interni verze 09 znamena UPX 0.7x, coz je velmi stara verze.}

Skok_Do_COM_souboru(vstup,vel_orig,vel_dekomp,savebyte);
Decode_UPX:=vel_dekomp;      {velikost dekomprimovanych dat}
end;

var s:string;
    p1:pointer;
    f1,f2:file;
    i,j:longint;
    w:word;

begin
s:='c:\tp\projekty\wokna32\ega.cpx';

GetMem(p1,$FFFF);


Assign(f1,s);
Reset(f1,1);
j:=FileSize(f1);
BlockRead(f1,p1^,j);
Close(f1);


w:=Decode_UPX(p1,j);

Assign(f2,'ega.ccc');
REwrite(f2,1);
BlockWrite(f2,p1^,w);
close(f2);
end.


