unit FI_TOOL;                                                                                                                  date:2001/05/11

{###########################################################################}
INTERFACE       { Public symbols }
{###########################################################################}

uses DOS;

type
  str80p     = ^str80;
  str80      = string[80];
  str37      = string[37];
  str25      = string[25];
  str13      = string[13];
  str12      = string[12];
  str08      = string[08];
  str04      = string[04];
  buf_l8     = array [1.. 8] of longint;
  buf_b64    = array [0..64] of byte;

  Trec_head  = record
                 sign :word;
                 lpage:word;    {02/03}
                 pagef:word;
                 reloc:word;    {06/07}
                 phead:word;
                 minm :word;    { 10, 0a/0b}
                 maxm :word;
                 _SS  :word;    { 14, 0e/0f}
                 _SP  :word;
                 crc  :word;    { 18, 12/13}
                 _IP  :word;
                 _CS  :word;    { 22, 16/17}
                 relo1:word;
                 overl:word;    { 26, 1a/1b}

                 tpkl :word;    { 28, 1Ch }
                 tlnk :word;    { 30 }
                 twin :longint; { 60 offset of NE/L?/PE }
                 id   :word;    { fill with offset(twin) or 0 }
                 nthdr:word;    { fill with optional headersize +18h }

                 entry:longint; { calculate }
                 psize:longint; { calculate }
                 osize:longint; { calculate }
               end;

const
  Tmem       = 65520;
  TTy        : byte = 1;
  Tcrc       : longint = { $A001{} $EDB88320; { value of polynom crc32 }
  flag_crc32 : longint = 0;
  flag_crcDOS: word    = 0;
  flag_crcPE : longint = 0;

var
  xbuf       : array[0..124] of word;
  xrec       : Trec_head;
  ebuf       : buf_b64;
  pebuf      : array[1..  5] of longint;

  cbuf       : word;
  flag_typ   : word;
  pos_range  : word;
  pos_s      : longint;

  f          : file;
  fsize      : longint;
  fattr      : str04;
  ftime      : str12;
  fdate      : str12;
  fname      : string;

  ergo       : word;
  s          : str80;


 {--------------------------------------------------------------------------}

  function  LDIV     (h,hdiv:longint)                       :longint;
  function  LMOD     (h,hmod:longint)                       :longint;
  function  HLB      (hnum:byte;    hdig:char)              :byte;
  function  HEX      (hnum:longint; hdig:byte; hchr:char)   :str12;
  function  DEZ      (hnum:longint; hdig:byte; hchr:char)   :str12;
  function  CRC32    (hmin,hmax,h_polynom:longint; hs:string):longint;
  function  CRCSUM16 (hs:string)                            :word;
  function  CRCSUM32 (hs:string)                            :longint;
  function  PETIME   (hchr:char; htime:longint)             :str12;

  procedure FILL_STR (var hs:str80; addstr:str08);
  procedure GET_NAME (var hs:str80; addpos:longint; hlen:byte; addstr:str25);
  procedure CUT_NAME (var hs:str80; anfi:byte; hlen:byte; hc:char; addi:shortint);

  function  GET_PARAM_PATH                                  :string;
  function  GET_PARAM_NAME                                  :string;
 {procedure EXECUTE         (progcmd:str12);}

  function  KPRESSED        (var hw:word)                   :boolean;
  procedure SET_KEYRATE     (h:boolean);
  procedure SETMODE         (modus:byte);
  procedure BLINK_TRUE      (flag_blink:boolean);
  procedure CURSOR          (flag_cursor:boolean);
  procedure SET_CURSOR      (hx,hy:byte);
  procedure SET_LINES       (h:byte);
  procedure GET_DAC         (h:word; rgbuf:pointer);
  procedure SET_DAC         (h:word; rgbuf:pointer);

  function  GET_TIME                                        :str08;
  function  GET_DATE                                        :str13;
  function  IS_REDIRECT                                     :boolean;
  function  FILE_OPEN       (var hf:file; hc:char; hs:string):boolean;
  procedure GET_BLOCK       (var hf:file; fpos:longint;
                                 inbuf:pointer; inlen:word);
  function  OFFLINE_JUMP    (hpos:longint)                  :longint;

  function  _32BIT          (h:byte)                        :longint;
  function  LONG2STR        (hnum:longint; hflag:boolean)   :str12;
  function  IS_MZ_HEADER                                    :boolean;
  procedure DOS_ENTRY;
  function  GET_OFS_PE      (hpos:longint)                  :longint;
  procedure GET_OBJ_VALUE   (h:word; var hbuf:buf_l8);
  procedure GET_EP_AND_FILL (var hflag:byte);

  function  IS_BUF   (hpos:word;               vglstr:str25):boolean;
  function  FOUND    (hpos:word;               vglstr:str25):boolean;
  function  IS_POS   (hpos:longint;            vglstr:str25):boolean;
  function  IS_JUMP  (hpos:longint; hrep:byte; vglstr:str25):boolean;
  function  GET_JUMP (hpos:longint; hlen:word)              :longint;
  function  IS_RANGE (hmin,hmax:word;          vglstr:str25):boolean;
  function  IS_FOUND (hmin,hmax:longint; vglstr:str80; flag_sensitive:boolean):boolean;

{###########################################################################}
 IMPLEMENTATION { Private symbols }
{###########################################################################}

function LDIV(h,hdiv:longint):longint;
var i:longint;         { divident / divisor = quotient }
begin
  asm
    db 66h; mov  bx, word ptr ss:[hdiv]      { divisor, 86400 = $15180 }
    db 66h; mov  ax, word ptr ss:[h]         { = petime }
    db 66h; xor  dx, dx
    db 66h; idiv bx                          { ax / bx = ax }
    db 66h; mov  word ptr ss:[i], ax
  end;
  LDIV:=i;
end;

function LMOD(h,hmod:longint):longint;
var i:longint;
begin
  asm
    db 66h; mov  bx, word ptr ss:[hmod]
    db 66h; mov  ax, word ptr ss:[h]
    db 66h; xor  dx, dx
    db 66h; idiv bx                          { ax % bx = dx }
    db 66h; mov  word ptr ss:[i], dx
  end;
  LMOD:=i;
end;

function HLB(hnum:byte; hdig:char):byte; assembler;
{ [01] *** šbergibt hi/lo byte *********************************************}
asm
  mov   AL, hnum
  mov   AH, hdig
  cmp   AH, 'h'               { Hi(AL)= AH='h', Lo(AL)= AH='l' }
  jne   @@1
  ror   AL, 4
@@1:
  and   AL, 0Fh
end;

function HEX(hnum:longint; hdig:byte; hchr:char):str12; assembler;
{ [02] *** Konvertiert Longint in HexString ********************************}
asm
  (*
  push  DS
  pop   ES
  mov   DI, offset HEX
  db 66h; mov   CX, word ptr SS:[hnum]
  xor   BX, BX
  mov   BL, hdig
  xor   AX, AX
  mov   AL, hchr
  *)
  cli
  mov   DX, 12
  lea   AX, SS:[hchr]         { last push before call }
  sub   AX, SP
  add   DL, AL
  add   SP, AX       { +4 (E8), +6 (9A)      }
  pop   AX                    { hchr , AL = 0, +2  }
  pop   BX                    { hdig , BL = 0, +4  }
  db 66h; pop   CX            { ECX = hnum   , +8  }
  pop   DI                    { Ofs of HEX   , +10 }
  pop   ES                    { Seg of HEX   , +12 }
  sub   SP, DX       { -16    , -18          }
  sti

  inc   BX                    { BX = count+1    }
  cmp   AL, 'X'
  jne   @@1
  inc   BX                    { BX = count+2 "0x" }

@@1:
  mov   byte ptr ES:[DI], BL  { BX = Stringlength }
  mov   SI, DI
  add   DI, BX
  cmp   AL, '$'               { Test "$" }
  je    @@2
  cmp   AL, 'X'               { Test "X" }
  je    @@2
  cld
  stosb ; sub   DI, 2         { hchr = 0000x; Offset = 000.h }

@@2:
  mov   DH, AL        { save hchr in DH      }
  mov   DL, 9
  db 66h; mov   AX, CX        { EAX = hnum   }
  mov   BX, 3037h
  mov   CX, 0F04h

  std
@@while:
  cmp   DI, SI      { while begin }
  je    @@end_while
  db 66h; push  AX
  and   AL, CH                { AL and 0Fh      }
  mov   AH, BH                { = 30h           }
  cmp   AL, DL                { Test <= 09      }
  jbe   @@w1
  mov   AH, BL                { = 37h           }
@@w1:
  add   AL, AH                { MAKE char       }
  stosb
  db 66h; pop   AX
  db 66h; SHR   AX, CL        { EAX shr 4       }
  jmp   @@while    { while end }

@@end_while:
  mov   AL, DH       { back hchr from DH     }
  cmp   AL, 'H'
  jne   @@3
  add   AL, 20h
  xor   CH, CH
  mov   CL, hdig
  mov   BX, CX
  mov   ES:[DI+BX+1], AL
  xor   BL, BL
  mov   AX, '0 '
@@5:
  inc   BX
  cmp   BX, CX
  je    @@end
  cmp   ES:[DI+BX], AH   { if value   ='0' }
  jne   @@end
  mov   ES:[DI+BX], AL   { then value =' ' }
  jmp   @@5
@@3:
  cmp   AL, 'X'
  jne   @@4
  add   AL, 20h
  mov   ES:[DI+ 2], AL        { hchr=0x0000, Offset = 0.0000 }
@@4:
  cmp   AL, '$'
  jne   @@end
  mov   ES:[DI+ 1], AL        { hchr=$0000, Offset = .0000 }

@@end:
(*
  push  ES            { Include to code, if  HEX(..):pointer }
  push  DI
  pop   AX
  pop   DX            { Result of Pointer in DX:AX == ES:DI  }
*)
end;

function DEZ(hnum:longint; hdig:byte; hchr:char):str12;
{ [03] *** Konvertiert Zahl zu String (<=12 Stellen) ***********************}
var hs:str12;
begin
  str(hnum:hdig, hs);
  DEZ:=hs;
  asm
    mov   AH, hchr
    cmp   AH, ' '
    je    @@end
    les   DI, [BP+0Eh]
    mov   CX, DI
    xor   BX, BX
  @@loop:
    cmp   BX, CX
    je    @@end
    inc   BX
    mov   AL, ES:[DI+BX]
    cmp   AL, ' '
    jne   @@end
    mov   ES:[DI+BX], AH
    jmp   @@loop
  @@end:
  end;
end;

function CRC32(hmin,hmax,h_polynom:longint; hs:string):longint;
var                    {global: ergo, cbuf, f, fsize}
  hf         :file;
  i,j        :word;
  h_crc,tmpl :longint;
  tmpi       :integer;
  T_crc      :array[0..255] of longint;
begin
  for j:=0 to 255 do   { generate CRC_TAB for overgiven polynom }
  begin
    asm
      db 66h; mov DX, word ptr SS:[h_polynom]
      db 66h; xor AX, AX
      mov   AL, byte ptr SS:[j]        { h_crc:=j; }
      mov   CX, 8                      { 8 bits }
    @@loopCX:                          { for i:=1 to 8 do begin }
      test  AL, 1                      { if (h_crc AND 1=1) then }
      pushf
      db 66h; shr AX, 1                { h_crc:=(h_crc shr 1) }
      popf
      jz    @@noXOR                    { else (not xor) }
      db 66h; xor AX, DX               { h_crc:= h_crc xor h_polynom }
    @@noXOR:
      loop  @@loopCX                   { end; }
      db 66h; mov word ptr SS:[h_crc], AX
    end;
    T_crc[j]:=h_crc;
  end;

  h_crc:=$ffffffff;             { initialize the CRC32 }
  if (cbuf<>0) and FILE_OPEN(hf,'R',hs) then
  begin
    if (hmin>fsize) then tmpl:=0 else tmpl:=hmin;
    if (hmax>fsize) then hmax:=fsize;
    Seek(hf,tmpl);

    repeat
      if (hmax-tmpl>$FFEF) then ergo:=$FFEF
      else                      ergo:=hmax-tmpl;
      inc(tmpl,ergo);
      {$I-}
       BlockRead(hf,mem[cbuf:1],ergo,ergo);
       tmpi:=IOResult;                   {this clears internal IOflag}
      {$I+}
      i:=1;
      while (i<=ergo) do
      begin
        {
        h_crc:=h_crc XOR mem[cbuf:i];
        h_crc:=T_crc[h_crc AND $FF] XOR (h_crc SHR 8);
        }
        h_crc:=T_crc[byte(h_crc) XOR (mem[cbuf:i])] XOR (h_crc shr 8);
        inc(i);
      end;
    until (tmpl>=hmax);
    Close(hf);
  end;
  CRC32:=h_crc XOR $ffffffff;   { adjust CRC32 at the end; $F and $F = 0 }
end;

function CRCSUM16(hs:string):word;
var                    {global: ergo, cbuf, f}
  RecordBuffer: Array [1..512] of Byte;
  WordBuffer  : Array [1..256] of Word absolute RecordBuffer;
  hf               :file;
  i,j,sum_crc,h_crc:word;
  tmpi             :integer;
begin
  sum_crc:= 0;
  h_crc  := xrec.crc + $FFFF;                  { initialize the CRCSUM }

  {$I-} Assign(hf,hs); Reset(hf,512); {$I+}
  if (hs[0]<>#0) and (IOResult=0) then
  begin
    for i:=1 to xrec.pagef do
    begin
      FillChar(RecordBuffer, 512, 0);
      {$I-}
      BlockRead(hf, RecordBuffer, 1, ergo);
      tmpi:=IOResult;                          { this clears internal IOflag }
      {$I+}
      for j:=1 to 256 do
      begin
        sum_crc:= sum_crc + WordBuffer[j];
        h_crc  := h_crc   - WordBuffer[j];
      end;
    end;
    Close(hf);
  end;
  CRCSUM16:=h_crc;
end;

function CRCSUM32(hs:string):longint;
var                    {global: ergo, cbuf, f}
  hf    :file;
  hflag :boolean;
  i     :word;
  h_crc :longint;
  h_fsz :longint;
  j,tmpl:longint;
  tmpi  :integer;
begin
  h_crc:=0; h_fsz:=fsize;                        { initialize the CRCSUM }

  if (cbuf<>0) and FILE_OPEN(hf,'R',hs) then
  begin
    j:=h_fsz; tmpi:=0; hflag:=false;
    while (j>0)and(tmpi=0) do
    begin
      if (j<Tmem) then i:=word(j) else i:=Tmem;    { 65520 bytes maximum }
      dec(j,i);

      {$I-}
      BlockRead (hf, mem[cbuf:0], i, ergo);
      tmpi:=IOResult;                        { this clears internal IOflag }
      {$I+}

      if (not hflag)and(tmpi=0) and
         ((xrec.id=$4550)or(xrec.id=$454E)) then   {PE, NE}
      begin
        if (xrec.id=$4550) then tmpi:=88
        else
        if (xrec.id=$454E) then tmpi:=8;
        tmpl:=FilePos(hf);
        if (tmpl-i<xrec.twin+tmpi)and(tmpl>xrec.twin+tmpi) then
        begin
          hflag:=true;
          tmpl:=(xrec.twin+tmpi)-(tmpl-i);
          meml[cbuf:word(tmpl)]:=0;
        end;
        tmpi:=0;                             { *IMPORTANT*, because while }
      end;

      asm
        push    DS
        mov  AX, word ptr DS:[cbuf]
        mov  DS, AX
        db 66h; xor  SI, SI                  { ESI = begin of membuffer }
        db 66h; mov  DX, word ptr SS:[h_crc] { get value for crcsum }
        mov   CX, i                          { length of calculation }
        shr   CX, 1                          { DIV 2, because word was needed ($FFFF) }
        cld                                  { direction flag to increment }
      @@loop:
        lodsw                                { instead movzx.. }
       {db 66h, 03Eh, 00Fh, 0B7h, 004h       { movzx EAX, dword ptr [ESI] }
        db 66h; add  DX, AX
        db 66h; mov  AX, DX
        db 66h, 081h, 0E2h, 0FFh, 0FFh, 0, 0 { and  EDX, 0FFFFh, attention TP lost the last 2 zeros }
        db 66h; shr  AX, 10h
        db 66h; add  DX, AX
       {inc   SI
        inc   SI                             { word increment, if movzx.. }
        loop  @@loop
        db 66h; mov  word ptr SS:[h_crc], DX { save value of crcsum }

        db 66h; mov  CX, word ptr SS:[j]     { get file read counter }
        db 66h; or   CX, CX
        jnz   @@end

        db 66h; mov  ax, dx                  { tmpl:=h_crc; }
        db 66h; shr  ax, 10h                 { tmpl:=tmpl SHR 16; }
        add   ax, dx                         { inc(h_crc,tmpl); }
        db 66h; add  AX, word ptr SS:[h_fsz] { inc(h_crc,h_fsz); }
        db 66h; mov  word ptr SS:[h_crc], AX { save adjust value of crcsum }

      @@end:
        pop   DS
      end;
    end;
    Close(hf);
  end;
  CRCSUM32:=h_crc;
end;

function PETIME(hchr:char; htime:longint):str12;
var
  i,j,k     :longint;
  hdiv,hmod :word;
  hflag     :boolean;
  hstr      :str12;
begin
  if (hchr='T') then     { TIME }
  begin
   {i:=htime mod 86400;}  {daytime left}
    i:=LMOD(htime,86400); hstr:=     DEZ(LDIV(i,3600),2,'0')+':';
    i:=LMOD(i,3600);      hstr:=hstr+DEZ(LDIV(i,60),2,'0')+':';
    i:=LMOD(i,60);        hstr:=hstr+DEZ(i,2,'0');
  end
  else                   { DATE }
  begin
   {i:=htime div 86400;}  {days since 01.01.1970 00:00:00, 31.12.1969 16:00:00}
    i:=LDIV(htime,86400);
    j:=LDIV(i,365); k:=2;                           {72,76,80,..,2000,2004..}
    while (j>k) do
    begin
      dec(i);                    {substract years with 29.02., here 366 days}
      inc(k,4);
    end;
    hstr:=DEZ(1970+LDIV(i,365),4,'0');           { writeln('Tage adj:',i); }

    k:=LDIV(i,365);   i:=LMOD(i,365); inc(i);
    hdiv:=LDIV(k,10);
    hmod:=LMOD(k,10);
    k:=0;
    hflag:=true;
    while hflag do
    begin
      inc(k);         {month}
      j:=28;                      {28}
      case k of
1,3,5,7,8,10,12:inc(j,3);         {31}
       4,6,9,11:inc(j,2);         {30}
      else                        {29}
      begin           {1972 = 02}
        if ( (hdiv in [0,2,4,6,8]) and (hmod in [2,6]) ) or
           ( (hdiv in [1,3,5,7,9]) and (hmod in [0,4,8]) ) then
        begin
          inc(j);
        end;
      end;
      end; {case end}
      if (i-j>0) then dec(i,j)
      else            hflag:=false;
    end;
    hstr:=DEZ(i,2,'0')+'.'+DEZ(k,2,'0')+'.'+hstr;
  end;
  PETIME:=hstr;
end;

{****************************************************************************
 ****************************** HELP_STRING *********************************
 ****************************************************************************}

procedure FILL_STR(var hs:str80; addstr:str08);
var h0:byte absolute hs;
begin
  if (h0>29) then h0:=29;
  while (h0<30) do
  begin
    inc(h0);
    hs[h0]:=#32;
  end;
  Insert(addstr,hs,succ(h0));
end;

procedure GET_NAME(var hs:str80; addpos:longint; hlen:byte; addstr:str25);
begin
  move(mem[cbuf:addpos],hs[1],hlen);
  hs[0]:=char(hlen);
  Insert(addstr,hs,hlen);
end;

procedure CUT_NAME(var hs:str80; anfi:byte; hlen:byte; hc:char; addi:shortint);
var i:byte;
begin
  i:=anfi; if (i>hlen) then i:=hlen;
  while (hs[i]<>hc)and(i<hlen) do inc(i);
  hs[0]:=char(i+addi);
end;


function GET_PARAM_PATH:string;
var hs:string;
begin
  hs:=fname;
  if (hs[ord(hs[0])]<>'\') then
  while (hs[0]>#0)and(hs[ord(hs[0])]<>'\') do dec(hs[0]);
  GET_PARAM_PATH:=hs;
end;


function GET_PARAM_NAME:string;
var i :byte;
    hs:string;
begin
  hs:=fname; i:=ord(hs[0]);
  while (i>0) and (hs[i]<>'\') do dec(i);
  if (i>0) then hs:=copy(fname,succ(i),ord(fname[0])-i);
  GET_PARAM_NAME:=hs;
end;

(*
procedure EXECUTE(progcmd:str12);
var
  para2,para3:str12;
  hs         :string;
begin
  para2:=GET_PARAM_NAME;
  para3:=para2;
  delete(para2,ord(para2[0])-1,2);
  delete(para3,ord(para3[0])-2,3);
  hs:=' /C '+progcmd+#32+GET_PARAM_NAME;
  hs:=hs+#32+para2+#32+para3+#32+DEZ(flag_typ,5,'0');
  hs:=hs+#32+GET_PARAM_PATH;
  SwapVectors;
  Exec(GetEnv('COMSPEC'),hs);
  SwapVectors;
end;
*)

{****************************************************************************
 ****************************** HELP_CRT ************************************
 ****************************************************************************}

function KPRESSED(var hw:word):boolean; assembler;
asm
  push  DS
  push  ES
  push  BP
  xor   AX, AX
  mov   ES, AX
  cli
  mov   DI, 041Ch
  mov   DX, ES:[DI]           { Pointer to end   }
  dec   DI
  dec   DI
  mov   AX, ES:[DI]           { Pointer to start }
  sti
  sub   AX, DX                { Taste gedrckt, ZF=1 }
  jz    @@end   { AL=0; false }
  mov   AX, 1000h             { erweiterten Tastaturcode lesen }
  int   16h
  cli
  mov   ES:[DI], DX           { Puffer leeren    }
  les   DI, hw
  mov   ES:[DI], AX           { AX = tasten wert }
  sti
  mov   AL, 1   { AL=1, true  }
@@end:
  pop   BP
  pop   ES
  pop   DS
end;

procedure SET_KEYRATE(h:boolean); assembler;
asm
  mov  AL, SS:[h]
  or   AL, AL
  jz   @@1
  mov  AL, 05h                { set new conditions         }
  xor  BH, BH                 { delay     = 250ms          }
  mov  BL, 04h                { typematic = 20 chars / sec }
@@1:
  mov  AH, 03
  int  16h
end;

procedure SETMODE(modus:byte); assembler;
{ *** Setzt einen bestimmten Bildschirmmodus ***}
asm
  jmp  @@run

@@vga: db 00h, 01h, 02h, 03h, 04h, 05h, 14h, 07h
       db 38h, 39h, 3Ah, 3Bh, 3Ch, 3Dh, 3Eh, 3Fh
       db 00h
@@run:
  push  ES
  push  DX
  push  BP
  cli
  in    AL, 61h
  and   AL, 0FCh
  out  61h, AL
  xor   AH, AH
  mov   AL, modus
  int   10h
  push  CS
  pop   ES
  mov   DX, offset @@vga
  mov   AX, 1002h
  int   10h
  sti
  pop   BP
  pop   DX
  pop   ES
end;

procedure BLINK_TRUE(flag_blink:boolean); assembler;
{ *** Intensit„tsbit umschalten ***}
asm
  mov   BL, SS:[flag_blink] { 1 = Blinken = true; 0 = hohe Intensit„t = false }
  mov   AX, 1003h
  int   10h
end;

procedure CURSOR(flag_cursor:boolean); assembler;
asm
  mov   CX, 2000h        {off}
  mov   AL, SS:[flag_cursor]
  or    AL, AL
  jz    @@end
  mov   CX, 0607h        {on}
@@end:
  mov   AX, 0100h
  int   10h
end;

procedure SET_CURSOR(hx,hy:byte); assembler;
asm                { GOTOXY = 79,TTy+23 }
  mov   DL, hx
  mov   DH, TTy
  add   DH, hy
  xor   BH, BH
  mov   AX, 0200h
  int   10h
end;

procedure SET_LINES(h:byte); assembler;
asm                 {valid 25, 30, 50 lines }
  jmp  @@run

@@30:
  dw   00C11h              { De-protect regs                    }
  dw   00B06h              { Vertical Total                     }
  dw   03E07h              { Vertical Overflow 1                }
  dw   04F09h              { Vertical Overflow 2                }
  dw   0EA10h              { Vertical Retrace Start             }
  dw   08C11h              { Vertical Retrace End & Re-protect  }
  dw   0DF12h              { Vertical Displayed                 }
  dw   0E715h              { Vertical Blanking Start            }
  dw   00416h              { Vertical Blanking End              }

@@run:
  push DS
  push BP
  {
  mov  AX, 03h
  int  10h
  }
  mov  CL, SS:[h]
  push CX                { save lines }
  xor  BX, BX
  mov  AX, 1114h         { 30 }
  cmp  CL, 30
  je   @@int10
  mov  AL, 12h           { 50 }
  cmp  CL, 50
  je   @@int10
  xor  AL, AL            { else 25 lines }
  pop  CX
  push 25
@@int10:
  int  10h

  cmp  CL, 30
  jne  @@end

  push CS
  pop  DS
  mov  SI, offset @@30   { Offset of CRTC data     }
  mov  dx, 03C4h         { Sequencer Port          }
  mov  ax, 0100h         { Synchronous reset       }
  out  dx, ax            { Send command            }
  mov  dx, 03CCh         { Misc Output Read Port   }
  in   al, dx            { Read byte               }
  or   al, 0C0h          { Set 480 scanlines       }
  mov  dx, 03C2h         { Misc Output Write Port  }
  out  dx, al            { Send command            }
  mov  dx, 03D4h         { CRT Controller Port     }
  mov  cx, 9             { 9 words                 }
  rep  outsw             { Send data               }
  mov  dx, 03C4h         { Sequencer Port          }
  mov  ax, 0300h         { Restart Sequencer       }
  out  dx, ax            { Send command            }

@@end:
  push 0                 { Tell the BIOS }
  pop  DS                { about the new }
  pop  AX                { back lines }
  dec  AX
  mov  DS:[0484h], AL            { ;height -1 }
  pop  BP
  pop  DS
end;

procedure GET_DAC(h:word; rgbuf:pointer); assembler;
asm
  push DS
  mov  BX, SS:[h]
  mov  AX, 1015h
  int  10h
  lds  SI, SS:[rgbuf]
  mov  byte ptr DS:[SI],   DH
  mov  byte ptr DS:[SI+1], CH
  mov  byte ptr DS:[SI+2], CL
  pop  DS
end;

procedure SET_DAC(h:word; rgbuf:pointer); assembler;
asm
  push DS
  cli
  mov  BX, SS:[h]
  lds  SI, SS:[rgbuf]
  mov  DH, byte ptr DS:[SI]
  mov  CH, byte ptr DS:[SI+1]
  mov  CL, byte ptr DS:[SI+2]
  mov  AX, 1010h
  int  10h
  sti
  pop  DS
end;

{****************************************************************************
 ***************************** HELP_DOS *************************************
 ****************************************************************************}


function GET_TIME:str08; assembler;
{ [0 ] *** mit Int 1Ah Zeit lesen (=8 Stellen) ****************************}
asm
  mov   AH, 2            {        Zeit         }
  int   1Ah              {  -=š CH:CL:DH š=-   }
  les   DI, [BP+06h]     { Stringadresse ES:DI }
  mov   AL, 8
  mov   ES:[DI], AL      { Stringl„nge = 08    }
  mov   DL, CL           {  š=- CH:DL:DH -=š   }
  mov   CL, 4            { 4 Bit's verschieben }
  mov   AH, 30h          { Addieren mit $30    }
  xor   BX, BX           { Z„hler fr Offset   }
@@write:
  mov   AL, CH           { Puffern des Wertes  }
  shr   AL, CL
  or    AL, AH
  inc   BX
  mov   ES:[DI+BX], AL   { HI byte }
  xchg  AL, CH           { Zurckholen }
  and   AL, 00001111b
  or    AL, AH
  inc   BX
  mov   ES:[DI+BX], AL   { LO byte }
  cmp   BX, 8
  je    @@end
  inc   BX
  mov   AL, $3A          { ":" }
  mov   ES:[DI+BX], AL
  cmp   BX, 3
  je    @@next
  mov   CH, DH           { Sekunde }
  jmp   @@write
@@next:
  mov   CH, DL           { Minute  }
  jmp   @@write
@@end:
end;

function GET_DATE:str13;
{ [0 ] *** mit Int 21h Datum lesen (=13 Stellen) ***}
const
  buf_day :array[0..13] of char = 'SoMoDiMiDoFrSa';
var
  i,_d,_m :byte;
  _y      :word;
  hs      :str13;

begin
  asm
    mov  AH, 2Ah
    push DS
    int  21h
    pop  DS
    mov   i, AL
    mov  _d, DL
    mov  _m, DH
    mov  _y, CX
  end;
  move(buf_day[i SHL 1],hs[1],2);
  hs[0]:=#3;
  hs[3]:=',';
  hs:=hs+DEZ(_d,2,'0')+'.'+DEZ(_m,2,'0')+'.'+DEZ(_y,4,'0');
  GET_DATE:=hs;
end;

{****************************************************************************
 ***************************** HELP_HEADER **********************************
 ****************************************************************************}

function IS_REDIRECT:boolean; assembler;
{ *** checks for StdOut redirection, return true if yes ************}
asm
  push  DS
  mov   bx, 1         {handle stdout}
  mov   ax, 4400h     {Query device/file}
  int   21h
  xor   ax, ax        {false}
  test  dx, 80h       {if Bit 7 = 0, then redirect to file}
  jnz   @@end
  inc   al            {true}
@@end:
  pop   DS
end;

function FILE_OPEN(var hf:file; hc:char; hs:string):boolean;
var h:byte;
begin
  h:=FileMode;
  if (hc='R') then FileMode:=0 else FileMode:=2;  { "R" = Read only }
  {$I-}
  Assign(hf,hs); Reset(hf,1);
  if (IOResult=0)and(hs[0]<>#0) then FILE_OPEN:=true
  else                               FILE_OPEN:=false;
  {$I+}
  FileMode:=h;
end;

procedure GET_BLOCK(var hf:file; fpos:longint; inbuf:pointer; inlen:word);
var hflag:integer; {global: ergo}
begin
  {$I-}
  Seek(hf,fpos);
  BlockRead(hf,inbuf^,inlen,ergo);
  hflag:=IOResult;                   {this clears internal IOflag}
  {$I+}
end;

function OFFLINE_JUMP(hpos:longint):longint;
var tmpl:longint; {global: fname, cbuf, pos_s, f}
begin
  tmpl:=hpos;
  if FILE_OPEN(f,'R',fname) then
  begin
    if IS_JUMP(tmpl,0,#0) then;
    if (tmpl=pos_s) and (IS_POS(tmpl,#$9A) or FOUND(0,#$EA))
      then tmpl:=GET_JUMP(tmpl,4)
    else   tmpl:=pos_s;
    Close(f);
  end;
  OFFLINE_JUMP:=tmpl;
end;

function _32BIT(h:byte):longint;
{ [0] *** Konvertiert word to longword ************************************}
begin {global xbuf}
  _32BIT:=longint(xbuf[succ(h)]) * $10000 +xbuf[h];
end;

function LONG2STR(hnum:longint; hflag:boolean):str12;
var
  i :byte;
  hs:str12;
begin
  hs[0]:=#0; i:=0;
  repeat
    hs:=hs+HEX((hnum SHR i) AND $FF,2,#32); dec(hs[0]);
    inc(i,8);
  until (i=32);
  if (not hflag) then dec(hs[0],4);
  LONG2STR:=hs;
end;

function IS_MZ_HEADER:boolean;
var tmpw:word;
begin    {global: xbuf,xrec,ebuf,ergo}
  FillChar(xbuf,SizeOF(xbuf),#0);        { clear for short files }
  GET_BLOCK(f,0,addr(xbuf),SizeOF(xbuf));           { fill xbuf  }
  move(xbuf,ebuf,SizeOF(ebuf));                     { fill ebuf  }
  move(xbuf,xrec,32);                               { fill xrec  }
  xrec.twin:=_32BIT(30);                            { header win }
  xrec.id  :=0;                                     { id = 0     }
  tmpw:=word(ebuf[7]) SHL 8 + ebuf[6];
  if (fsize>tmpw)and(fsize<65520) then
  begin
    if IS_BUF(0,#$FF#$FF#$FF#$FF) or IS_POS(word(ebuf[1] SHL 8 + ebuf[0]),#$FF#$FF#$FF#$FF) then
         xrec.entry:=tmpw                           { sys-entry }
    else xrec.entry:=0;
  end
  else xrec.entry:=0;
  if (xrec.sign<>$5A4D)and(xrec.sign<>$4D5A) then IS_MZ_HEADER:=false
  else                                            IS_MZ_HEADER:=true;
end;

procedure DOS_ENTRY;
begin     {global: xrec,fsize}
  xrec.id:=0;
  with xrec do
  begin
    osize:=pagef; if (lpage=0) then inc(osize);
    psize:=(longint(512)*pred(osize)) +lpage;
    osize:=fsize -psize;
    entry:=(longint(phead) SHL 4) +(longint(_CS) SHL 4) +_IP;
    entry:=entry AND $FFFFF;
  end;
end;

function GET_OFS_PE(hpos:longint):longint;
var {global fsize, xbuf}
  i,j,tmpl:longint;
  hrec  :record
           i_rva:longint; {v.size}
           rva  :longint;
           i_ofs:longint; {p.size}
           ofs  :longint;
         end;
begin
  i:=0; j:=xrec.twin+xrec.nthdr+8; tmpl:=maxlongint;
  repeat
    GET_BLOCK(f,j+(i*40),addr(hrec),16);
    if (tmpl>hrec.rva) then tmpl:=hrec.rva;    {min.RVA}
    inc(i);
  until (i>=xbuf[03]) or
      ( (hpos=hrec.rva)and(hrec.i_ofs<>0) ) or
      ( (hpos>hrec.rva)and(hpos<hrec.rva+hrec.i_ofs) );

  if (hpos>=tmpl) then                         {else hpos stay}
  begin
    dec(hpos,hrec.rva); inc(hpos,hrec.ofs);    {hrva-rva+physofs}
    if (hpos>fsize) then hpos:=0;              {out of range}
  end;
  GET_OFS_PE:=hpos;
end;

function GET_LX_SIZE(hpmin,hpmax:longint):longint;
var
  hflag:word;
  tmpl :longint;
  h    :longint;
  hsize:longint;
  hsum :longint;
begin
  hsize:=_32BIT(22);                             { shifted size to align }
  if (hsize>0) then hsize:=1 SHL byte(hsize);
  h:=hpmin; hsum:=0;
  while (h<hpmax) do                             { min. page to max. page -1 }
  begin
   {Seek(f,xrec.twin+_32BIT(36)+(h*8)+4); BlockRead(f,tmpl,4,ergo);}
    GET_BLOCK(f,xrec.twin+_32BIT(36)+(h*8)+4,addr(tmpl),4); { ofs(sig)+ofs(pages)+counter }
    hflag:=tmpl SHR 16;
    tmpl :=tmpl AND $FFFF;
    if (tmpl<>_32BIT(20))and(hsize>0)and(tmpl MOD hsize<>0)  then
    begin
      tmpl:=succ(tmpl DIV hsize) * hsize;        { smallest align }
    end;
    inc(hsum,tmpl);                              { phys.size=hsum }
    inc(h);
  end;
  GET_LX_SIZE:=hsum;                             { phys.Size }
end;

function GET_LX_OFS(h:word):longint;
var
  hidd :longint;
  tmpl :longint;
  hofs :longint;
  hbuf :buf_l8;
begin
  hofs:=_32BIT(64);                              { ofs data page }
  tmpl:=_32BIT(20);                              { size of pages }
 {Seek(f,xrec.twin+_32BIT(32)+(j*24)); BlockRead(f,hbuf,24,ergo);} { prev.pages }
  GET_BLOCK(f,xrec.twin+_32BIT(32)+(h*24),addr(hbuf),24); { ofs(sig)+ofs(pages)+counter }

  if (Hi(xbuf[0])=$58) then  {LX}
  begin
   {Seek(f,xrec.twin+_32BIT(36)+(i*8)); BlockRead(f,tmpl,4,ergo);}
    GET_BLOCK(f,xrec.twin+_32BIT(36)+(pred(hbuf[4])*8),addr(hbuf),8); { ofs(sig)+ofs(pages)+counter }
    if ((hbuf[2] SHR 16) AND 1=1) then hofs:=_32BIT(38); { ofs(iterate) }
    inc(hofs,hbuf[1] SHL byte(_32BIT(22)));              { now shifted left }
  end

  else                       {LE}
  begin
    hidd:=40;
    while (_32BIT(hidd)=0) do inc(hidd,4);
    hidd:=((_32BIT(hidd) - _32BIT(36)) SHR 2) - _32BIT(10);
    if (pred(hbuf[4])>1) then hidd:=pred(hbuf[4])-hidd
    else                      hidd:=pred(hbuf[4]);
    inc(hofs,hidd*tmpl);                        { PageSize*PageCounts  }
  end;

  GET_LX_OFS:=hofs;                             { phys.Ofs  }
end;

procedure GET_OBJ_VALUE(h:word; var hbuf:buf_l8); {j=0.._32BIT(34)}
var hidd :longint;
begin
 {Seek(f,xrec.twin+_32BIT(32)+(j*24)); BlockRead(f,hbuf,24,ergo);} { hbuf[1]..hbuf[6] }
  GET_BLOCK(f,xrec.twin+_32BIT(32)+(h*24),addr(hbuf),24); { ofs(sig)+ofs(obj)+counter }
  if (Hi(xbuf[0])=$58) then {LX}
  begin
    hbuf[7]:=pred(hbuf[4])+hbuf[5];
    hbuf[7]:=GET_LX_SIZE(pred(hbuf[4]),hbuf[7]); { hbuf[7] = phys.Size }
  end
  else                      {LE}
  begin
    hidd:=40;
    while (_32BIT(hidd)=0) do inc(hidd,4);
    hidd:=((_32BIT(hidd) - _32BIT(36)) SHR 2) - _32BIT(10);

    hbuf[7]:=hbuf[5] * _32BIT(20);               { PageSize*PageCounts  }
    if (hbuf[5]<>0) then                         { _32BIT(10) = max.page }
    begin
      if (pred(hbuf[4])+hbuf[5]=_32BIT(10)+hidd) then
      begin
        dec(hbuf[7],_32BIT(20));
        inc(hbuf[7],_32BIT(22));                 { +LastpageSize }
      end
      else
      if (hidd>0) then dec(hbuf[7],hidd*_32BIT(20));
    end;                                         { hbuf[7] = phys.Size }
  end;
  hbuf[8]:=GET_LX_OFS(h);                        { hbuf[8] = phys.Ofs  }
end;

procedure GET_EP_AND_FILL(var hflag:byte);
var
  i   :word;
  j,j1:longint;
  hbuf:buf_l8;

  hbue:array[1..8] of word;
  tmpw,n,o:word;
  k,kmax,kofs,kj,tmpl:longint;

begin     {global: xbuf,xrec,pebuf,ergo}
  j1:=xrec.pagef; if (xrec.lpage=0) then inc(j1);
  j1:=(longint(512)*pred(j1)) +xrec.lpage;
  if (fsize>j1) then
  begin
    if IS_POS(j1,#$4C#$01) or FOUND(0,'PMW1') or FOUND(0,'Adam') or
       FOUND(0,'XE'#01#00) then xrec.twin:=j1
  end;
  if (xrec.twin<fsize) then j:=xrec.twin
  else                      j:=0;
  FillChar(xbuf,SizeOf(xbuf),0);
  GET_BLOCK(f,j,addr(xbuf),SizeOF(xbuf));
  xrec.id   :=xbuf[0];
  xrec.nthdr:=xbuf[10]+$18;
  if (hflag and 2=2) then  { flag for FI, what for a header to show }
  begin
    case xrec.id of
{NE} $454E:begin
             xrec.entry:=0; pebuf[5]:=fsize; j1:=0;
             if (xbuf[11]>0)and(xbuf[14]>0) then  { CS<>0, segcount<>0 }
             begin
               if (hi(xbuf[06]) and 8=0) then  { no selfloader bit }
                    j1:=(xbuf[11]*8)-8;
               xrec.entry:=xrec.twin+xbuf[17]+j1; { headanf +segofs +(cs*8-8) }
              {Seek(f,xrec.entry); BlockRead(f,xrec.entry,2,ergo);}
               GET_BLOCK(f,xrec.entry,addr(xrec.entry),2);       { read offset }
               xrec.entry:=(xrec.entry SHL xbuf[25]) AND $FFFFF; { offset SHL AlignShift }

               if (hi(xbuf[06]) and 8=0) then inc(xrec.entry,xbuf[10]) { offset +IP }
               else
               if IS_POS(xrec.entry,#$41#$30) then
               begin
                 j1:=byte(mem[cbuf:$18]);
                 if IS_POS(xrec.entry+4,#$69#$01#$FF#$FF#$E7#$01#$06) then
                   inc(xrec.entry,$30)       {optloader dll}
                 else
                 if FOUND(0,#$6D#$01#$FF#$FF#$F7#$01#$06) then
                   inc(xrec.entry,$33)       {optloader}
                 else
                 if FOUND(0,#$FA#$03#$FF#$FF#$FE#$00#$06) then
                   inc(xrec.entry,$90)       {installshield}
                 else
                 if FOUND($10,#$FF#$FF#$00#$00#$8C#$C1#$01#$F9#$E3#$01#$59#$C3) then
                   inc(xrec.entry,$18)       {winlite}
                 else
                 if IS_POS (xrec.entry+$80,#$FF#$FF#$00#$00#$E9) and
                    IS_JUMP(xrec.entry+$84,0,#$55#$FC#$BB#$10#$00#$AD#$8B) then
                   inc(xrec.entry,$84)       {pklite}
                 else
                 if IS_FOUND(xrec.entry,xrec.entry+$80,'inker: ',true) then
                   inc(xrec.entry,j1-$20);   {blinker/shrinker}
               end
               else inc(xrec.entry,xbuf[10]);
             end;

             j:=0; k:=0; kmax:=0; kofs:=0;       {segment loop}
             repeat
               GET_BLOCK(f,xrec.twin+xbuf[17]+(j*8),addr(hbue),8);
              { kj:=kofs; }
               kofs:=longint(hbue[1]) SHL xbuf[25];
               tmpl:=kofs+hbue[2];
               if (hbue[3] AND $100=$100) then
               begin
                 GET_BLOCK(f,tmpl,addr(tmpw),2);
                 inc(tmpl,(tmpw SHL 3)+2);
               end;
               if (hbue[1]>0) then k:=tmpl;
               if (k>kmax) then kmax:=k;
               inc(j);
             until (j>=xbuf[14]);

             tmpl:=kmax;
             if (xbuf[18]+20<=xbuf[19]) then     {resources loop}
             begin
               j:=0; k:=0; n:=0; o:=0;
               repeat
                 GET_BLOCK(f,xrec.twin+xbuf[18]+j,addr(hbue),16);
                 if (hbue[1]+hbue[2]<>0) then
                 begin
                   tmpl:=longint(hbue[6]) SHL xbuf[25];
                   if (j=0) then kofs:=tmpl
                   else
                   if (kofs>tmpl)and(tmpl>0) then kofs:=tmpl; { phys.ofs }
                   inc(tmpl,longint(1 SHL xbuf[25])*hbue[7]);
                   if (kmax<tmpl) then kmax:=tmpl;            { phys.end }
                   inc(k,longint(1 SHL xbuf[25])*hbue[7]);    { size }
                   if (j=0) then kj:=hbue[3]
                   else
                   begin
                     if (kj>1) then dec(kj)
                     else           kj:=hbue[3];
                   end;
                 end;

                 if (kj=1) then
                 begin
                   inc(o);
                   inc(j,20);
                 end
                 else inc(j,12);
                 inc(n);
               until (hbue[1]+hbue[2]=0)or(xrec.twin+xbuf[18]+j>xrec.twin+xbuf[19]);
               pebuf[5]:=kmax;     {overlay}
             end;

           end;
{PE} $4550:begin
             FillChar(pebuf,SizeOF(pebuf),0);
             j:=_32BIT(20); xrec.entry:=GET_OFS_PE(j);

             if (j<>0)and(_32BIT(14)<>0) then
             begin
               i:=0; j1:=0; {pebuf[5]:=0;}
               repeat
                {Seek(f,xrec.twin+$F8+(i*40)-40+8); BlockRead(f,pebuf[1],16,ergo);}
                 GET_BLOCK(f,xrec.twin+xrec.nthdr+(i*40)+8,addr(pebuf[1]),16);
                 if (pebuf[4]>0)and(pebuf[4]+pebuf[3]>pebuf[5]) then pebuf[5]:=pebuf[4]+pebuf[3];
                 if (j>=pebuf[2]) then j1:=i;
                 inc(i);
               until (i>=xbuf[03]);
               xrec.entry:=GET_OFS_PE(j);   {entry}

               i:=0;
               while (i<=j1) do
               begin
                 GET_BLOCK(f,xrec.twin+xrec.nthdr+(i*40)+8,addr(pebuf[1]),16);
                 inc(i);
               end;
               (*
               pebuf[1]:=last RVA size
               pebuf[2]:=RVA seg
               pebuf[3]:=last PHY size
               pebuf[4]:=last PHY seg
               pebuf[5]:=[4]+[3]
               *)
             end
             else
             begin
               i:=0;
               while (i<=xbuf[03]) do
               begin
                 GET_BLOCK(f,xrec.twin+xrec.nthdr+(i*40)+8,addr(pebuf[1]),16);
                 if (pebuf[4]>0)and(pebuf[4]+pebuf[3]>pebuf[5]) then pebuf[5]:=pebuf[4]+pebuf[3];
                 inc(i);
               end;
             end;
           end;
{L?} $454C,
     $584C:begin
             xrec.entry:=0; j:=_32BIT(12);
                        {CS}  {count object}
             if (j>0)and(j<=_32BIT(34)) then
             begin
               xrec.entry:=GET_LX_OFS(word(pred(j)));
               inc(xrec.entry,_32BIT(14));                    { offset +IP }

                        {iterated}       {objects}
               if (_32BIT(38)<>0)and(_32BIT(34)<>0) then
               begin
                 i:=0;
                 repeat
                   GET_OBJ_VALUE(i,hbuf);    { ofs(sig)+ofs(pages)+counter }
                   GET_BLOCK(f,xrec.twin+_32BIT(36)+(pred(hbuf[4])*8),addr(hbuf[1]),8);
                   inc(i);
                 until ((hbuf[2] SHR 16)=0)or(i>=word(_32BIT(34))); {count objects}
                 if (i>j) then
                 begin
                   if (hbuf[2] SHR 16=0)and(hbuf[3] AND 4=4)
                     then xrec.entry:=(_32BIT(64)+hbuf[1]) SHL byte(_32BIT(22))
                   else   dec(xrec.entry,_32BIT(14));
                 end;
               end;
             end;

             i:=0; j:=0; pebuf[5]:=0;
             repeat
               GET_OBJ_VALUE(i,hbuf);
               if (hbuf[5]=0)or(hbuf[7]=0) then hbuf[8]:=j;
               j:=hbuf[8]+hbuf[7];
               if (pebuf[5]<j)and(hbuf[8]>0) then pebuf[5]:=j;
               inc(i);
             until (i>=word(_32BIT(34)));
             if (_32BIT(68)>=pebuf[5]) then inc(pebuf[5],_32BIT(70)); {nonres}
             if (_32BIT(76)<>0)        then inc(pebuf[5],_32BIT(78)); {debug}
             if (pebuf[5]=0) then pebuf[5]:=fsize;
           end;
{COF}$014C:begin
             xrec.entry:=_32BIT(18); j1:=xrec.twin+20+xbuf[08]+8;
             if (xrec.entry<>0) then
             begin
               i:=0;
               repeat
                 GET_BLOCK(f,j1+(i*40),addr(pebuf[1]),16);
                 inc(i);
               until (i>=xbuf[01]) or
                    ((xrec.entry>=pebuf[2]) and
                     (xrec.entry-pebuf[2]<pebuf[3]));
               if (i>1)and(pebuf[1]<>_32BIT(20)) then
               begin
                 xrec.entry:=0;
               end
               else inc(xrec.entry,xrec.twin+pebuf[4]-pebuf[2]);
             end;

             FillChar(pebuf,SizeOF(pebuf),0);
             i:=0; j:=0; pebuf[5]:=0;
             repeat
               GET_BLOCK(f,j1+(i*40),addr(pebuf[1]),16);
               j:=xrec.twin+pebuf[4]+pebuf[3];
               if (pebuf[4]>0)and(j>pebuf[5]) then pebuf[5]:=j;
               inc(i);
             until (i>=xbuf[01]);
           end;
{PMW}$4D50:begin
             xrec.entry:=xrec.twin+_32BIT(18); pebuf[5]:=xrec.entry;
            {inc(xrec.entry,_32BIT(06));}             {+eip}
             i:=0;
             repeat
               GET_BLOCK(f,xrec.twin+_32BIT(12)+(i*24)+4,addr(pebuf[1]),4);
               inc(pebuf[5],pebuf[1]);
               inc(i);
             until (i>=_32BIT(14));
           end;
{Ada}$6441:begin
             if (lo(xbuf[02])<$50) then
             begin
               xrec.entry:=_32BIT(06)+_32BIT(12);
               j1:=_32BIT(04);
             end
             else
             begin
               xrec.entry:=_32BIT(08)+_32BIT(10);
               j1:=_32BIT(06);
             end;
             inc(xrec.entry,xrec.twin);
             pebuf[5]:=xrec.twin+j1;
           end;
{XE} $4558:begin
             xrec.entry:=_32BIT(02);
             inc(xrec.entry,xrec.twin);
             pebuf[5]:=xrec.entry+_32BIT(10)+_32BIT(12)+_32BIT(14);
           end;
(*
{MZ} $5A4D,
     $4D5A:begin {DOS4GW}
             GET_BLOCK(f,xrec.twin,addr(xbuf),SizeOF(xbuf));
             move(xbuf,ebuf,SizeOF(ebuf));          { fill ebuf  }
             move(xbuf,xrec,32);                    { fill xrec  }
             DOS_ENTRY;
           end;
*)
    else DOS_ENTRY;
    end; {case end}
  end
  else DOS_ENTRY;
  if (fsize>xrec.entry) then j:=xrec.entry
  else                       j:=0;
 {Seek(f,j); BlockRead(f,ebuf,SizeOF(ebuf),ergo);}
  GET_BLOCK(f,j,addr(ebuf),SizeOF(ebuf));
end;


{****************************************************************************
 ***************************** HELP_CHECK ***********************************
 ****************************************************************************}

function IS_BUF(hpos:word; vglstr:str25):boolean; assembler;
{ [01] *** Sucht in festem Puffer [0..64] nach einer Bytefolge }
asm   {## global: ebuf }
  cld                         { increment }
  push ES
  lea  SI, DS:[ebuf]          { ebuf is an array in DS }
  adc  SI, SS:[hpos]          { buffer seek   , DS:SI }
  les  DI, SS:[vglstr]        { vglstr seek   , ES:DI }

  xor  CX, CX
  mov  AL, ES:[DI]            { length string }
  inc  DI                     { seek to first char }
  xchg AL, CL                 { AL =0 and CL =length }
  repe cmpsb
  jne  @@end                  { not equal, false }
  inc  AX                     { flag true, AL=1  }
@@end:
  pop  ES
end;

function FOUND(hpos:word; vglstr:str25):boolean; assembler;
{ [02] *** Sucht in variablem Puffer (vorher fllen) nach einer Bytefolge }
asm   {## global: cbuf }
  cld                         { increment      }
  push ES
  push DS
  push word ptr DS:[cbuf]     { segment of mem[cbuf:0] }
  pop  ES
  mov  DI, SS:[hpos]          { buffer seek   , ES:DI }
  lds  SI, SS:[vglstr]        { vglstr seek   , DS:SI }

  xor  CX, CX
  lodsb                       { length string + seek }
  xchg AL, CL
  repe cmpsb
  jne  @@end                  { not equal, false }
  inc  AX                     { flag true, AL=1  }
@@end:
  pop  DS
  pop  ES
end;

function IS_RANGE(hmin,hmax:word; vglstr:str25):boolean;
var i    :word;
    hflag:boolean;
begin
  i:=hmin; hflag:=false;
  while (not hflag)and(i<=hmax) do
  begin
    if (mem[cbuf:i]=ord(vglstr[1])) and FOUND(i,vglstr) then
    begin
      hflag:=true;
      pos_range:=i;              {range from hmin..hmax, but minor 65520}
    end;
    inc(i);
  end;
  IS_RANGE:=hflag;
end;

function IS_POS(hpos:longint; vglstr:str25):boolean;
{ [03] *** Sucht in variablem Puffer (Lesezugriff) nach einer Bytefolge }
begin { global: f, cbuf }
  FillChar(mem[cbuf:0],64,#32);       { 64 Bytes mit Leerzeichen fllen }
  if (hpos>fsize) then hpos:=fsize;
 {Seek(f,hpos); BlockRead(f,mem[cbuf:0],64,ergo);}
  GET_BLOCK(f,hpos,addr(mem[cbuf:0]),64);
  IS_POS:=FOUND(0,vglstr);
end;

function IS_JUMP(hpos:longint; hrep:byte; vglstr:str25):boolean;
{ [04] *** Sucht in variablem Puffer (Lesezugriff) nach einer Bytefolge,
           die von call/jump angesprungen wird }
var i,tmpl:longint;
    j,k   :word;
    h     :byte;
    hflag :boolean;
    hbuf  :array[1..4] of longint;
begin {## global: f, cbuf, pebuf, trec.twin }
  h:=0; hflag:=false; i:=hpos;
  if (i<fsize) then
  repeat
    inc(h);
   {Seek(f,i); BlockRead(f,mem[cbuf:0],5,ergo);}
    GET_BLOCK(f,i,addr(mem[cbuf:0]),5);
    case mem[cbuf:0] of
      $EB:begin
            j:=mem[cbuf:1]; inc(i,2);
            if (j>$7F) then i:=pred(i-($FF-j))
            else            inc(i,j);
          end;
  $E8,$E9:begin
            if (xrec.id<>$4550) and  {PE}
               (xrec.id<>$454C) and  {LE}
               (xrec.id<>$584C) and  {LX}
               (xrec.id<>$014C) and  {COFF}
               (xrec.id<>$6441) and  {ADAM}
               (xrec.id<>$457F)      {ELF-linux}
            then
            begin
              k:=$FFFF;
              j:=(memw[cbuf:1] +3) and k;
              inc(i,j);
              if ((i and k) < j) then dec(i,$10000);
            end
            else
            begin
              if (h>1) then tmpl:=i else tmpl:=hpos;
              inc(i,5);
              asm
                push DS
                mov  AX, word ptr DS:[cbuf]
                mov  DS, AX
                xor  SI, SI
                inc  SI
                db   66h; lodsw                    { j = EAX }

                push SS
                pop  DS
                db   66h; mov  BX, word ptr DS:[i]
                db   66h; mov  DX, BX              { i = EDX, EBX }

                db   66h, 0B9h,0FFh,0FFh,0FFh,0FFh { k = mov  ECX, $FFFFFFFF }
                db   66h; and  DX, CX              { EDX:=i and k }
                db   66h; sub  CX, AX              { ECX:=k - j   }

                db   66h; cmp  CX, DX
                jae  @@add
                inc  CX
                db   66h; sub  BX, CX              { EBX:=i - (k-j+1) }
                jmp  @@end

              @@add:
                db   66h; add  BX, AX              { EBX:=i + j }

              @@end:
                db   66h; mov word ptr DS:[i], BX  { i:=EBX }
                pop  DS
              end;

              if (xrec.id=$4550) then   {PE}
              begin
                j:=1; hflag:=false;
                while (j<=xbuf[3]) and (not hflag) do
                begin
                  GET_BLOCK(f,xrec.twin+xrec.nthdr+pred(j)*40+8,addr(hbuf[1]),16);
                  if (tmpl>=hbuf[4])and(tmpl<hbuf[4]+hbuf[3]) and
                     (i>=hbuf[4])and(i<hbuf[4]+hbuf[3]) then hflag:=true;
                  inc(j);
                end;
                if (not hflag) then
                begin
                  i:=i + pebuf[2] - pebuf[4];
                  j:=0;
                  repeat
                    GET_BLOCK(f,xrec.twin+xrec.nthdr+j*40+8,addr(hbuf[1]),16);
                    inc(j);
                  until (hbuf[2]=0) or ((i>=hbuf[2])and(i<=hbuf[2]+hbuf[3]));
                  i:=hbuf[4] +(i-hbuf[2]);
                end;
              end;

            end;
          end;
    end; {case end}
    if (i>=0)and(i<fsize) then
    begin
      hflag:=IS_POS(i,vglstr);
      pos_s:=i;
    end
    else pos_s:=hpos;
  until (hflag) or (i<0) or (i>=fsize) or (h>hrep) or
       ((mem[cbuf:0]<>$E8)and(mem[cbuf:0]<>$E9)and(mem[cbuf:0]<>$EB));
  IS_JUMP:=hflag;
end;

function GET_JUMP(hpos:longint; hlen:word):longint;
var tmpl:longint; {global: xrec}
begin
  GET_BLOCK(f,succ(hpos),addr(mem[cbuf:0]),hlen); {get seg:ofs of longjump/call }
  tmpl:=(longint(memw[cbuf:2]) SHL 4);
  inc(tmpl,longint(xrec.phead) SHL 4);
  inc(tmpl,memw[cbuf:0]);
  GET_JUMP:=tmpl;
end;

function IS_FOUND(hmin,hmax:longint; vglstr:str80; flag_sensitive:boolean):boolean;
{ [05] *** Sucht in variablem Puffer (Lesezugriffe von min bis max)
           nach einer Bytefolge }
var h,tmpw         :word;
    i              :longint;
    hflag,flag_seek:boolean;
begin {## global: f, cbuf, fsize, pos_s }
  if (hmax > fsize)     then hmax:=fsize;
  if (hmin < 0)         then hmin:=0;
  if (hmin > hmax)      then hmin:=hmax;
  h:=Tmem;
  if (hmax-hmin < Tmem) then h:=hmax-hmin;  {speed up}
  hflag:=false; pos_s:=0;
  Seek(f,hmin);
  repeat
    {$I-}
    BlockRead(f,mem[cbuf:0],h,tmpw);        {tmpw = count of reading bytes}
    i:=IOResult;                            {clear flag}
    {$I+}
    if flag_sensitive and (tmpw>0) then     {tmpw = 0, that's bleeding }
    begin
      for i:=0 to pred(tmpw) do
      case mem[cbuf:i] of
        $41..$5A:inc(mem[cbuf:i],$20);
 {Ž}    $8E:mem[cbuf:i]:=$84;
 {™}    $99:mem[cbuf:i]:=$94;
 {š}    $9A:mem[cbuf:i]:=$81;
      end; {case end}
    end;
    asm
      push  DS
      push  ES

      xor   DX, DX
      mov   flag_seek, DL          { false }
      mov   AX, word ptr DS:[cbuf]
      mov   ES, AX                 { es:=bufseg }
      xor   DI, DI                 { buffer seek, ES:0 }
      push  SS
      pop   DS
      lea   SI, DS:[vglstr]        { vglstr seek, DS:SI }
      mov   CX, DS:[tmpw]          { cx = BufferLength, DS=SS }
      cld
      lodsb
      mov   DL, AL                 { dh= 0,  dl= StringLength }
      lodsw                        { si+2, al = String[1], ah = String[2] }
      dec   SI                     { si = StringOffset[1] }
      dec   SI
    @@loop:
      repne scasb                  { cx-1, di+1, cmp al,es:[di] }
      je    @@found                { when equal last byte in buffer }
      jcxz  @@end_loop
    @@found:
      cmp   DL, 1                  { when for one char searching only }
      je    @@end_one
      inc   CX        { because one char is reading before }
      cmp   CX, DX                 { TailBuffer < StringLength }
      jb    @@end_seek             { yes? }
      dec   CX        { cx value back }
      (*
      xchg  AL, AH                 { compare second }
      scasb                        { di+1, Test String[2] = true }
      pushf
      xchg  AL, AH                 { back compare first }
      dec   DI                     { di-1, next byte for loop }
      popf*)
      cmp   byte ptr ES:[DI], AH
      jne   @@loop                 { first 2 StringChars are not equal!! }

      push  CX
      push  DI
      push  SI
      mov   CX, DX                 { CX:=StringL„nge }
      dec   DI                     { di-1, BufferOffset = String[1] }
      repe  cmpsb
      pop   SI
      pop   DI
      pop   CX
      jne   @@loop                 { all StringChars are not equal!! }

    @@end_one:
      dec   DI                     { di-1, BufferOffset = String[1] }
      mov   AX, 1                  { flag_found:=true }
      jmp   @@end
    @@end_seek:
      mov   SS:[flag_seek], 1      { flag_seek:=true }
    @@end_loop:
      xor   AX, AX                 { flag_found:=false }
    @@end:
      mov   hflag, AL              { flag_found }
      pop   ES
      pop   DS
      mov   tmpw, DI               { Offset in MemoryRange }
    end;

    i:=FilePos(f);
    if flag_seek and (hmax>i) then
    begin
      Seek(f,i-ord(vglstr[0]));
      i:=FilePos(f);
    end;
    if (hflag) then
    begin
      if (pos_s<Tmem) then pos_s:=hmin+tmpw
      else                 inc(pos_s,tmpw);
    end
    else pos_s:=i;
  until (hflag) or (i>=hmax);
  if hflag then GET_BLOCK(f,pos_s,addr(mem[cbuf:0]),h)
  else          pos_s:=hmax;
  IS_FOUND:=hflag;
end;

begin
end.