HPAVC/HPAVC CD-ROM.iso/pc/FM-EXT20.ZIP/FM-EXT.PAS

Pascal/Delphi Source File | 1995-09-20 | 49.2 KB | 1,718 lines

Program Fast_Module_Extractor;
{$L FONT.OBJ}

Uses EnhDOS;

Const Buffer = 32767;  {Search buffer}

Type bytearray = Array [0..Buffer] Of char;
     CharSet = Set OF Char;

Var
  header                    :array[1..4] of char;
  option                    :array[1..3] of string;
  sample                    :bytearray;
  doserror                  :integer;
  attr, found, res,
  patternsize, x, y         :word;
  total, Position, l        :longint;
  filenum, infile1, infile2,
  min,s,hund,min_old,s_old,
  hund_old                  :byte;
  h,r,g,b                   :byte;
  ID,tempstring,filename    :string;
  pP,pFileName              :pchar;
  Search                    :tsearchrec;
  D                         :tdirstr;
  N                         :tnamestr;
  E                         :textstr;
  ReadOnlyFile              :boolean;
  TheTime                   :real;

Procedure Setfont;external; {Included with FONT.OBJ}

Function IsVGA: boolean;assembler;
   asm
        xor     bx,bx
        mov     ax,01A00h
        int     010h
        mov     ax,1
        cmp     bl,7
        jnc     @@ok
        cmp     bl,8
        jnc     @@ok
        xor     ax,ax
    @@ok:
  end;

function readkey:char;
var t:char;
begin
  asm
    xor ah,ah
    int 16h
    mov t,al
  end;
  readkey:=t;
end;

procedure writeit(s:string;x,y:word;attr:byte);
begin
asm
    mov ax,y
    dec ax
    mov dx,80
    mul dx
    dec ax
    add ax,x
    shl ax,1
    mov di,ax {Calculation of beginning of string in videomemory}

    mov ax,0B800h
    mov es,ax
    xor ch,ch
    mov cl,byte ptr s[0]
    mov si,0
    mov bh,attr
@w: inc si
    mov bl,byte ptr s[si]
    mov es:[di],bx
    inc di
    inc di
    loop @w
  end;
end;

Procedure cursoroff;assembler; {Hey, Borland! build this in a CRT or DOS unit}
  asm
    MOV   ax,$0100
    MOV   cx,$2607
    INT   $10
  end;

Procedure cursoron;assembler; {Hey, Borland! build this in a CRT or DOS unit}
  asm
    MOV   ax,$0100
    MOV   cx,$0506
    INT   $10
 end;

procedure Upper(var Str: String); {Thanks Bob Swart!!}
  InLine(
    $8C/$DA/               {      mov   DX,DS               }
    $5E/                   {      pop   SI                  }
    $1F/                   {      pop   DS                  }
    $FC/                   {      cld                       }
    $AC/                   {      lodsb                     }
    $30/$E4/               {      xor   AH,AH               }
    $89/$C1/               {      mov   CX,AX               }
    $E3/$12/               {      jcxz  @30                 }
    $BB/Ord('a')/Ord('z')/ {      mov   BX,'za'             }
    $AC/                   { @15: lodsb                     }
    $38/$D8/               {      cmp   AL,BL               }
    $72/$08/               {      jb    @28                 }
    $38/$F8/               {      cmp   AL,BH               }
    $77/$04/               {      ja    @28                 }
    $80/$6C/$FF/$20/       {      sub   BYTE PTR [SI-1],$20 }
    $E2/$F1/               { @28: loop  @15                 }
    $8E/$DA);              { @30: mov   DS,DX               }

function LeadingZero(w : Word) : String;
var
  s : String;
begin
  Str(w:0,s);
  if Length(s) = 1 then s := '0' + s;
  LeadingZero := s;
end;

Function GetString(cx,cy,cc,pc : Byte; Default,Prompt : String; MaxLen : Integer;OKSet :charset):string;

{ cx = Input Column }
{ cy = Input Row    }
{ cc = Input Color  }
{ pc = Prompt Color }

const
  BS                 = #8;
  CR                 = #13;
  ESC                = #27;
  iPutChar           = #249;
  ConSet             : CharSet = [BS,CR,ESC];
var
  TStr:string;
  x,i,tlen:byte;
  Ch:char;

begin
  TStr := '';
  TLen := 0;
  writeit(prompt,cx,cy,pc);
  x := cx + ord(Prompt[0]);
  For i := x to (x + Maxlen - 1) do writeit(iputChar,i,cy,cc);
  if default<>'' then writeit(default,x,cy,cc);
  OKSet := OKSet + ConSet;
  cursoron;
  repeat
    asm
      mov ah,2
      mov dh,cy
      dec dh
      mov dl,x
      dec dl
      mov bh,0
      int 10h
    end;
    repeat
       ch:=readkey
    until ch in OKSet;
    if tlen=0 then for i := x to (x + ord(default[0])) do writeit(iputChar,i,cy,cc);
    case ch of
    BS: begin
          if TLen > 0 then begin
                             dec(TLen);
                             dec(x);
                             WriteIt(iPutChar,x,cy,cc);
                           end;
        end;
    else if (Ch<>CR) and (Ch<> ESC) and (TLen < MaxLen) then
         begin
           WriteIt(Ch,x,cy,cc);
           inc(TLen);
           TStr[TLen] := Ch;
           inc(X);
         end;
    end;
  until (Ch = CR) or (Ch = ESC);
  If Tlen > 0 Then Begin
                     TStr[0] := chr(Tlen);
                     Getstring := TStr
                   End
  Else Getstring := Default;
  cursoroff;
end;


Procedure drawline(Line: Integer;color:byte); {Draws a line...}
Var i: Integer;
Begin
  writeit('■',1,line,color);
  For i := 2 To 79 Do writeit('─',i,line,color);
  writeit('■',80,line,color);
End;

Procedure clearline;  {Go to statusline and set color}
var i:byte;
Begin
  for i:=1 to 80 do writeit(' ',i,14,112);
End;

procedure drawbar(m,line:byte);

begin
  For Y := 2 To (m+1) Do
  Begin
    writeit('█',2+(Y shr 2),line,126);
    str(m,tempstring);
    writeit (' '+tempstring+'%  ',27,line,126);
  End;
End;

procedure read68000_32bit(var b:longint);
var temp: longint;
    hoog:byte;
begin
         b:=0;
         h_Read(infile2,hoog,sizeof(hoog));
         temp:=hoog;
         b:=temp shl 24;
         h_read(infile2,hoog,sizeof(hoog));
         temp:=hoog;
         b:=b+(temp shl 16);
         h_read(infile2,hoog,sizeof(hoog));
         temp:=hoog;
         b:=b+(temp shl 8);
         h_read(infile2,hoog,sizeof(hoog));
         temp:=hoog;
         b:=b+temp;
end;

procedure smoothexit;

var i,vel:word;

begin
  writeit('Thanks for using...',30,35,3);
  i:=0;
  vel:=0;
  REPEAT {Credits to VangeliSTeam for this code!}
      WHILE (Port[$3DA] AND 8) =  8 DO;
      asm cli end;
      Port[$3d4] := $c; Port[$3d5] := HI((i DIV 16)*80);
      Port[$3d4] := $d; Port[$3d5] := LO((i DIV 16)*80);
      WHILE (Port[$3DA] AND 8) <> 8 DO;
      Port[$3d4] := 8; Port[$3d5] := (Port[$3d5] AND $E0) OR (i AND $0F);
      asm sti end;
      inc (vel); {more increments...more speed}
      inc (vel);
      inc (vel);
      inc (vel);
      i := i + (vel DIV 16);
  UNTIL i >= 25*16;
  cursoron;
  asm
   mov ax,3h
   int 10h
  end;
  Halt;
end;

Procedure waitforkey; {wait until a key is pressed}
Begin
  writeit('■',2,18,252);
  if Readkey=#27 then SmoothExit
                 else clearline;
  writeit(' ',2,18,112)
End;

Function SaveIt(s:string;position:longint):boolean;

begin
  clearline;
  str(position,tempstring);
  writeit (s+' found at position '+tempstring+'. Save it (y/N)?',2,14,121);
  Case ReadKey of
  #89,#121: SaveIt:=True;
      #27: SmoothExit;
  else begin
         SaveIt:=False;
         writeit ('                                                   ',30,9,113);
       end;
  End;
end;

Procedure Written(s:string;length:longint);
begin
  clearline;
  str(length,tempstring);
  writeit(s+' written: '+tempstring+' bytes.',2,14,121);
  waitforkey;
end;


Procedure writefile (ext:string;filebegin,filelength: LongInt); {Copies the mod out of the demo}
Var filelengthstr,fileout:string;
  outfile: byte;
  err:word;
  pfileout:pchar;
  writebuffer: Array [1..4096] Of Byte;
  numread,buffers: Integer;
  temp:char;
  i: LongInt;
  continue:boolean;
  OldSearchRec:TSearchRec;

Begin
  GetMem(pFileOut,80);
  OldSearchRec:=Search;
  gettime(h,min,s,hund);
  repeat
    continue:=true;
    clearline;
    cursoron;
    inc(filenum);
    str(filenum,tempstring);
    tempstring:=tempstring+'.'+ext;
    fileout:=GetString(2,14,112,112,tempstring,'Enter filename: ',62,['!'..'~']);
    pfileout:=pas2pchar(fileout);
    if existsfile(pfileout) then
      begin
        cursoroff;
        writeit('File already exists. Overwrite it ['+fileout+'] (Y/n)',2,14,112);
        temp:=readkey;
        if (temp=#78) or (temp=#110) then continue:=false
        else continue:=true;
        clearline;
        DeleteFile(pfileout);
      end;
  until continue;
  cursoroff;
  err:=h_seek(infile2,filebegin,0);
  outfile:=h_Createfile(pfileout);
  for i:=2 to 26 do writeit('▒',i,9,112);
  buffers:=(filelength div sizeof(writebuffer));
  str(filelength:7,filelengthstr);
  for i:=1 to buffers do
    begin
      h_read(infile2,writebuffer,sizeof(writebuffer));
      h_write(outfile,writebuffer,sizeof(writebuffer));
      str(4096*i:7,tempstring);
      writeit(' Processing: '+tempstring+' bytes of '+filelengthstr+' bytes.',1,7,121);
      drawbar((100*4096*i) div filelength,9);
    end;
  h_read(infile2,writebuffer,filelength-(4096*buffers));
  h_write(outfile,writebuffer,filelength-(4096*buffers));
  writeit(' Processing: '+filelengthstr+' bytes of '+filelengthstr+' bytes.',1,7,121);
  drawbar(100,9);
  h_closefile(outfile);
  settime(h,min,s,hund);
  Search:=OldSearchRec;
End;

Procedure DisplayHelp;
var i,o:byte;

begin;
    for x:=1 to 80 do writeit(' ',x,1,79);
    writeit (' Fast Module Extractor 2.0 ',1,1,79);
    for x:=2 to 25 do for y:=1 to 80 do writeit(' ',y,x,112);
    writeit (' Usage: FM-EXT filename <options>',1,3,126);
    writeit (' Extracts: FastTracker 1.x and 2.0x modules',1,6,121);
    writeit ('           ScreamTracker 2.x and 3.x modules',1,7,121);
    writeit ('           MultiTracker and 669 modules',1,8,121);
    writeit ('           Farandole and UltraTracker modules',1,9,121);
    writeit ('           DigiTrakker, PolyTracker and Delusion modules',1,10,121);
    writeit ('           AMF, MIDI and Wave-files',1,11,121);
    writeit ('           LBM, BMP-pictures and FLI, FLC-animations',1,12,121);
    writeit (' Detects:  GIF, JPG',1,13,121);
    writeit (' Wildcards allowed!',1,15,124);
    writeit ('  Options: X                Turn on BMP, 669, FLI, FLC searching',1,17,120);
    writeit ('           !<ABCD> <offset> Custom header search (1..255 chars!)',1,18,120);
    writeit ('           #<begin> <end>   Partial copy mode',1,19,120);
    writeit (' See DOCs for details',1,21,127);
    drawline(23,125);
    drawline(25,117);
    tempstring:=GetString(2,24,7,7,'','>FM-EXT ',70,[' '..#255]);
    pp:=Pas2PChar(tempstring);
    i:=0;
    for x:=1 to 3 do
    begin
      if pp[i]=' 'then
         repeat inc(i) until pp[i]<>' ';
      o:=1;
      repeat
        option[x,o]:=pp[i];
        inc(i);
        inc(o);
      until (pp[i]=' ') or (pp[i]=#0);
      option[x,0]:=chr(o-1);
    end;
End;

Procedure write669; {Extracts ComposD 669}
Var title669: Array [1..108] Of Char;
  nos, nop: Byte;
  sample: Word;
  begin669,temp,Length669, i: LongInt;

Begin
  gettime(h,min,s,hund);
  Position := (l - res) + X; {Where is the start}
  Length669 := 0;
  If (search.size - position) > 110 Then
    begin
      Begin669 := Position - 1;  {Calculate 669 beginning}
      h_Seek (infile2, Begin669 + 2,0);
      h_Read (infile2, title669, SizeOf (title669) );
      h_Seek(infile2, Begin669 + 110,0);
      h_Read (infile2, nos,SizeOf (nos) ); {Read # of samples}
      h_Read (infile2, nop,SizeOf (nop) ); {Read # of patterns}
      h_Seek (infile2, begin669 + 510,0);
      For i := 1 To nos Do
        Begin              {Read NOS times the sample lengths}
          h_Read (infile2, sample, SizeOf (sample) );
          h_Seek (infile2, (begin669 + 510) + (i * $19),0 );
          Length669 := Length669 + sample;
        End;
      temp:=nop;
      Length669 := Length669 + (temp * 1536);
      temp:=nos;
      Length669 := Length669 + (temp * $19) +$1F1; {Calculate total length}
      if (length669 > 0) and ((Begin669 +length669) <= search.size) Then
      begin
        writeit ('Title: ',33,9,113);
        For i := 1 To 36 Do writeit (title669 [i],39+i,9,113);
        For i := 37 To 72 Do writeit (title669 [i],39+(i-36),10,113);
        For i := 73 To 108 Do writeit (title669 [i],39+(i-72),11,113);
        ID:='669 File';
        if SaveIt(ID,begin669) then
          Begin
            writefile ('669',begin669,Length669); {writeit it!}
            written(ID,length669);

          end;
        writeit('                                             ',39,10,113);
        writeit('                                             ',39,11,113);
        clearline;
      end;
    end;
  settime(h,min,s,hund);
End;

Procedure writeS3M; {Extracts ScreamTracker 3.0 files}
Var titleS3M: Array [1..28] Of Char;
  noo, nos, nop: Word;
  sample: Word;
  memseg: Word;
  i,begins3m, lengths3m, memsegold, Length: LongInt;
  t: Byte;

Begin
  gettime(h,min,s,hund);
  Position := (l - res) + X;
  lengths3m := 0;
  memsegold := 0;
  Begins3m := Position - 45;
  h_seek (infile2, Begins3m,0);
  h_read (infile2, titleS3M, SizeOf (titleS3M) ); {Read title}
  h_seek (infile2, Begins3m + 32,0);
  h_read (infile2, noo, SizeOf (noo) ); {Read # of orders}
  h_read (infile2, nos, SizeOf (nop) ); {Read # of patterns}
  h_read (infile2, nop, SizeOf (nos) ); {Read # of samples}
  h_seek (infile2, begins3m + 96 + noo,0);
  if nos <> 0 then For i := 0 To nos - 1 Do                 {Read NOS times the pointers to all samples}
    Begin
      h_seek (infile2, begins3m + 96 + noo + i + i,0);
      h_read (infile2, sample, SizeOf (sample) );
      h_seek (infile2, 14 + begins3m + (sample * 16) ,0);
      h_read (infile2, memseg, SizeOf (memseg) );
      If memseg > memsegold Then
        Begin
          memsegold := memseg;
          h_read (infile2, Length, SizeOf (Length) ); {Read last sample length}
          lengths3m := (memsegold * 16) + Length;        {Add last sample length and last filepointer}
        End;
      End;
  if (lengths3m > 0) and ((Begins3m +lengths3m) <= search.size) Then
  begin
    ID:='ScreamTracker 3.0';
    writeit ('Title: '+ titleS3M,34,9,113);
    if SaveIt(ID,position) then
      Begin
        writefile ('S3M',begins3m,lengths3m);
        written(ID,lengths3m);
      end;
    clearline;
  end;
  settime(h,min,s,hund);
End;

Procedure writeMTM; {Extracts MultiTracker 1.x files}
Var titleMTM: Array [1..20] Of Char;
  lps, nos: Byte;
  loc, trks: Word;
  i,beginmtm, lengthmtm, sample: LongInt;

Begin
  gettime(h,min,s,hund);
  Position := (l - res) + X;
  lengthmtm := 0;
  If (search.size - position) > 100 Then
    begin
      Beginmtm := Position - 1;
      h_seek (infile2, Beginmtm + 4,0);
      h_read (infile2, titleMTM, SizeOf (titleMTM) ); {Read title}
      h_seek (infile2, Beginmtm + 24,0);
      h_read (infile2, trks, SizeOf (trks) ); {Read # of tracks}
      h_read (infile2, lps, SizeOf (lps) );   {Read # of ?}
      h_seek (infile2, beginmtm + 28,0);
      h_read (infile2, loc, SizeOf (loc) );
      h_read (infile2, nos, SizeOf (nos) );   {Read # of samples}
      lengthMTM := (194 + (nos * 37) + (trks * 192) + ( (lps + 1) * 32 * 2) + loc);
      h_seek (infile2, beginMTM + 88,0);
      For i := 1 To nos Do
         begin
           h_read (infile2, sample, SizeOf (sample) );
           h_seek (infile2, (beginmtm + 88) + (i * 37) ,0);
           lengthMTM := lengthMTM + sample;
         end;
      if (lengthmtm > 0) and ((Beginmtm + lengthmtm) <= search.size) Then
        begin
          writeit('Title: '+titleMTM,34,9,113);
          ID:='MultiTracker Module';
          if SaveIt(ID,beginmtm) then
            begin
              writefile ('MTM',beginmtm,lengthmtm);
              written(ID,lengthmtm);
            end;
          clearline;
        end;
    end;
  settime(h,min,s,hund);
End;

Procedure WriteMOD;{(patternsize: word); {Flexible MOD file extractor}
Var i, modbegin,modlength: LongInt;
    title: Array [1..20] Of Char;
    Pattern: Array [1..128] Of Byte;
    number,laag, hoog: Byte;

Begin
  gettime(h,min,s,hund);
  Position := (l - res) + X;
  number:=0;
  modlength := 0;
  ModBegin := Position - 1081;
  if ModBegin >= 0 then
    begin
      h_seek (infile2, ModBegin,0);
      h_read (infile2, title, SizeOf (title) ); {Reads title}
      h_seek (infile2, ModBegin + 42,0);
      For i := 1 To 31 Do  {Reads sample sizes}
         Begin
           h_read (infile2, hoog, SizeOf (hoog) );
           h_read (infile2, laag, SizeOf (laag) );
           h_seek (infile2, ModBegin + 42 + (i * 30) ,0);
           modlength := modlength + ( (hoog * 256) + laag);
         End;
      modlength := modlength * 2;
      h_seek (infile2, Modbegin + 952,0);
      h_read (infile2, Pattern, 128); {Reads pattern order, highest number -> number of patterns}
      For i := 1 To 128 Do If number < Pattern [i] Then number := Pattern [i];
      i:=patternsize; {Must convert patternsize to longint...causes otherwise an FP error}
      modlength := modlength + ( (number + 1)* i) + 1084;
      h_seek (infile2, ModBegin,0);
      if (modlength > 0) and ((ModBegin +Modlength) <= search.size) Then
        begin
          writeit('Title: '+ title,34,9,113);
          str(patternsize div 256,tempstring);
          ID:=tempstring+' Channel MOD File';
          if SaveIt(ID,position) then
            begin
              writefile('MOD',modbegin,modlength);
              written(ID,modlength);
            End;
          clearline;
       end;
    end;
  settime(h,min,s,hund);
End;

Procedure writeSTM; {Extracts ScreamTracker 2.x / BMOD2STM / SWavePro files}

Var i, beginstm,stmlength: LongInt;
  title: Array [1..20] Of Char;
  los: Word;
  nop: Byte;

Begin
  gettime(h,min,s,hund);
  Position := (l - res) + X;
  stmlength := 0;
  Beginstm := Position - 25;
  h_seek (infile2, Beginstm,0);
  h_read (infile2, title, SizeOf (title) );
  h_seek (infile2, Beginstm + 33,0);
  h_read (infile2, nop, SizeOf (nop) ); {Read # of patterns}
  h_seek (infile2, Beginstm + 64,0);
  stmlength := nop;
  stmlength := stmlength * 1024;
  For i := 1 To 31 Do
    Begin
      h_read (infile2, los, SizeOf (los) );
      h_seek (infile2, Beginstm + 64 + (i * 32) ,0);
      If (los mod 16) <> 0  Then los := 16*(los Div 16);
      stmlength := stmlength + los;
    End;
  stmlength := stmlength + (31 * 32) + 48 + 128;
  if (stmlength > 0) and ((Beginstm +stmlength) <= search.size) Then
   begin
     writeit ('Title: '+ title,34,9,113);
     ID:='ScreamTracker 2.x';
     if SaveIt(ID,beginstm) then
        Begin
          writefile ('STM',beginstm,stmlength);
          written(ID,stmlength);
        end;
     clearline;
   end;
  settime(h,min,s,hund);
End;

Procedure writeAMF; {Extracts DMP format .AMF, copies from header to end of file}
                    {so the length isn't always accurate}
Var amfbegin,amflength: LongInt;
  title: Array [1..30] Of Char;
Begin
  gettime(h,min,s,hund);
  Position := (l - res) + X;
  amflength := 0;
  amfBegin := Position - 1;
  h_seek (infile2, amfBegin + 4,0);
  h_read (infile2, title, SizeOf (title) );
  writeit ('Title: '+ title,34,9,113);
  amflength := search.size - amfbegin;
  ID:='AMF File';
  if SaveIt(ID,amfbegin) then
       Begin
         writefile ('AMF',amfbegin,amflength);
         written(ID,amflength);
       End;
  clearline;
  settime(h,min,s,hund);
End;

Procedure writeDMF; {Delusion Music Format}
var dmfbegin,dmflength: LongInt;
    title: Array [1..30] Of Char;
Begin
  gettime(h,min,s,hund);
  Position := (l - res) + X;
  dmflength := 0;
  dmfBegin := Position - 1;
  h_seek (infile2, dmfBegin + 13,0);
  h_read (infile2, title, SizeOf (title) );
  writeit ('Title: '+ title,34,9,113);
  dmflength := search.size - dmfbegin;
  ID:='Delusion Music File';
  if SaveIt(ID,dmfbegin) then
       Begin
         writefile ('DMF',dmfbegin,dmflength);
         written(ID,dmflength);
       End;
  clearline;
  settime(h,min,s,hund);
End;

Procedure writeMDL;
Var mdlbegin,mdllength,blocklen: LongInt;
                          title: array[1..32] of Char;
                        blockID: array[1..2] of char;
                              i: byte;
begin
  gettime(h,min,s,hund);
  Position := (l - res) + X;
  mdllength := 5;
  mdlBegin := Position - 1;
  h_seek (infile2, mdlBegin + 11,0);
  h_read (infile2, title, sizeof(title));
  h_seek (infile2, mdlBegin + 5,0);
  h_read (infile2, blockID, 2);
  i:=1;
  repeat
    h_read(infile2, blocklen, 4);
    MDLlength:=MDLLength+blocklen+6;
    h_seek(infile2, MDLbegin + MDLlength,0);
    h_read(infile2, blockID,2);
    inc(i);
  until (blockID='SA') or (i > 15);
  h_read (infile2, blocklen, 4);
  MDLlength:=MDLLength+blocklen+6;
  if (mdllength > 0) and ((MdlBegin +Mdllength) <= search.size) Then
    begin
      writeit ('Title: '+ title,34,9,113);
      ID:='DigiTrakker MDL File';
      if SaveIt(ID,mdlbegin) then
        begin
          writefile ('MDL',mdlbegin,mdllength);
          written(ID,mdllength);
        end;
      clearline;
    end;
  settime(h,min,s,hund);
end;

Procedure writeXM; {Write's FastTracker 2.0 XM (Extended Module) files}

Var XMbegin,XMlength: LongInt;
    j,HeaderSize,PatternSize,InstrSize,SampHeadSize,SampleLength,TotalSample:Longint;
    PackPattSize:word;
    ii,i,NOP,NOI,NOS:word;
    check: Array [1..17] Of Char;
    title: Array [1..20] of Char;

Begin
  gettime(h,min,s,hund);
  Position := (l - res) + X;
  XMlength := 0;
  XMBegin := Position - 1;
  h_seek(infile2, XMBegin,0);
  h_read(infile2, check, sizeof(check));
  if check='Extended Module: ' then
    begin
      h_seek(infile2, XMBegin+17,0);
      h_read(infile2, title, sizeof(title));
      h_seek(infile2, XMBegin+60,0);
      h_read(infile2, headersize,4);
      h_seek(infile2, XMBegin+70,0);
      h_read(infile2, NOP,2);
      h_seek(infile2, XMBegin+72,0);
      h_read(infile2, NOI,2);
      if (NOI<=128) and (NOP<=256) then
        begin
          patternsize:=0;
          PackPAttSize:=0;
          j:=0;
          for i:= 1 to NOP do
            begin
              h_seek(infile2, XMBegin+60+headersize+j,0);
              h_read(infile2, patternsize,4);
              h_seek(infile2, XMBegin+60+headersize+j+7,0);
              h_read(infile2, PackPattSize,2);
              j:=j+packpattsize+patternsize;
            end;
          XMLength:=HeaderSize+60+j;
          j:=0;
          for i:= 1 to NOI do
            begin
              h_seek(infile2,XMBegin+XMLength+j,0);
              h_read(infile2, Instrsize,4);
              h_seek(infile2,XMbegin+XMLength+j+27,0);
              h_read(infile2, NOS,2);
              if NOS<>0 then
                begin
                  h_seek(infile2,XMBegin+XMLength+j+29,0);
                  h_read(infile2,SampHeadSize,4);
                  j:=j+InstrSize;
                  TotalSample:=0;
                  for ii:=1 to NOS do
                    begin
                      h_seek(infile2,XMBegin+XMLength+j,0);
                      h_read(infile2,SampleLength,4);
                      j:=j+SampHeadSize;
                      TotalSample:=TotalSample+Samplelength;
                    end;
                  j:=j+TotalSample;
                end
              else
              j:=j+InstrSize;
            end;
          XMLength:=XMLength+j;
          if (xmlength > 0) and ((xmBegin + xmlength) <= search.size) Then
            begin
              writeit ('Title: '+ title,34,9,113);
              ID:='FastTracker 2.0 File';
              if SaveIt(ID,xmbegin) then
                begin
                  writefile('XM',xmbegin,xmlength);
                  written(ID,xmlength);
                end;
              clearline;
            end;
        end;
    end;
   settime(h,min,s,hund);
End;


Procedure writeFAR; {Extracts Farandole composer files}
                    {Reads from header to end of file, so search.name isn't always OK}
Var i, farbegin,farlength: LongInt;
  title: Array [1..40] Of Char;
  headerlength,songtextlength:word;
  nop:byte;
Begin
  gettime(h,min,s,hund);
  Position := (l - res) + X;
  farlength := 0;
  farBegin := Position - 1;
  h_seek (infile2, farBegin + 4,0);
  h_read (infile2, title, SizeOf (title) );
  writeit ('Title: '+ title,34,9,113);
  farlength := search.size - farbegin;
  ID:='Farandole File';
  If SaveIt(ID,farbegin) then
  Begin
         writefile ('FAR',farbegin,farlength);
         written(ID,farlength);
  End;
  clearline;
  settime(h,min,s,hund);
End;

Procedure writeULT; {Extracts UltraTracker format, copies from header to end of file}
                    {so the length isn't always accurate}
Var i, ultbegin,ultlength: LongInt;
  title: Array [1..32] Of Char;
Begin
  gettime(h,min,s,hund);
  Position := (l - res) + X;
  ultlength := 0;
  ultBegin := Position - 1;
  h_seek (infile2, ultBegin + 15,0);
  h_read (infile2, title, SizeOf (title) );
  writeit ('Title: '+ title,34,9,113);
  ID:='UltraTracker File';
  ultlength := search.size - ultbegin;
  if SaveIt(ID,ultbegin) then
  Begin
         writefile ('ULT',ultbegin,ultlength);
         written(ID,ultlength);
  End;
  clearline;
  settime(h,min,s,hund);
End;

Procedure writePTM; {Extracts PolyTracker format, copies from header to end of file}
                    {so the length isn't always accurate...mostly NOT}
Var titlePTM: Array [1..28] Of Char;
  noo, nos, nop: Word;
  sample, slength: LongInt;
  i,beginPTM, lengthPTM, memsegold, Length: LongInt;
  t: Byte;

Begin
  gettime(h,min,s,hund);
  Position := (l - res) + X;
  lengthPTM := 0;
  memsegold := 0;
  BeginPTM := Position - 45;
  h_seek (infile2, BeginPTM,0);
  h_read (infile2, titlePTM, SizeOf (titlePTM) ); {Read title}
  h_seek (infile2, BeginPTM + 32 + 2,0);
  h_read (infile2, nos, SizeOf(nos));
  h_seek (infile2, BeginPTM + 608 + 18,0);
  if nos <> 0 then
  begin
      h_seek (infile2, beginPTM+608 + 18 + ((nos-1)*80),0);
      h_read (infile2, sample, SizeOf(sample));
      h_read (infile2, slength, SizeOf(slength));
      lengthPTM:=slength+sample;
  end;
  if (lengthPTM > 0) and ((BeginPTM +lengthPTM) <= search.size) Then
  begin
    ID:='PolyTracker File';
    writeit ('Title: '+ titlePTM,34,9,113);
    if SaveIt(ID,beginPTM) then
      Begin
        writefile ('PTM',beginPTM,LengthPTM);
        written(ID,lengthPTM);
      end;
    clearline;
  end;
 settime(h,min,s,hund);
End;

Procedure writePAC; {Extracts SB Studio PAC file}
Var i, pacbegin,paclength: LongInt;

Begin
  gettime(h,min,s,hund);
  Position := (l - res) + X;
  paclength := 0;
  pacBegin := Position - 1;
  h_seek (infile2, pacBegin + 4,0);
  h_read(infile2, paclength,4);
  paclength:=paclength+8;
  if (paclength > 0) and ((pacBegin + paclength) <= search.size) Then
    begin
      ID:='SB Studio .PAC File';
      if SaveIt(ID,pacbegin) then
        Begin
          writefile ('LBM',pacbegin,paclength);
          written(ID,paclength);
        End;
      clearline;
    end;
  settime(h,min,s,hund);
End;

procedure writeMIDI;
var i,hoog,laag,noft:byte;
    midibegin,tracklength,midilength:longint;
begin
  gettime(h,min,s,hund);
  Position := (l - res) + X;
  midilength := 0;
  tracklength:=0;
  midiBegin := Position - 1;
  h_seek(infile2,midibegin+10,0);
  h_read(infile2,hoog,sizeof(hoog));
  h_read(infile2,laag,sizeof(laag));
  noft:=(hoog*256)+laag;  {Number of tracks}
  h_seek(infile2,midibegin+14,0);
  for i:=1 to noft do
    begin
      h_seek(infile2,h_filepos(infile2)+4+tracklength,0);
      read68000_32bit(tracklength);
      midilength:=midilength+tracklength;
    end;
  midilength:=midilength+14+(noft*8);
  if (midilength > 0) and ((midiBegin+midilength) <= search.size) Then
  begin
    ID:='MIDI File';
    if SaveIt(ID,midibegin) then
      begin
        writefile('MID',midibegin,midilength);
        written(ID,midilength);
      end;
    clearline;
  end;
  settime(h,min,s,hund);
end;

Procedure writeLBM; {Extracts LBM graphics file}
Var i, lbmbegin,LBMlength: LongInt;
    header:array[1..4] of char;
    t: Byte;
Begin
  gettime(h,min,s,hund);
  Position := (l - res) + X;
  lbmlength := 0;
  lbmBegin := Position - 1;
  h_seek (infile2, lbmBegin + 4,0);
  read68000_32bit(lbmlength);
  h_seek(infile2, lbmBegin + 12,0);
  h_read(infile2, header,4);
  lbmlength:=lbmlength+8;
  if (header='BMHD') and (lbmlength > 0) and ((lbmBegin +lbmlength) <= search.size) Then
    begin
      ID:='LBM Picture';
      if SaveIt(ID,lbmbegin) then
        Begin
          writefile ('LBM',lbmbegin,lbmlength);
          written(ID,lbmlength);
        End;
      clearline;
    end;
  settime(h,min,s,hund);
End;

Procedure writeBMP; {Extracts BMP files}
Var bmpbegin,BMPlength: LongInt;
Begin
  gettime(h,min,s,hund);
  Position := (l - res) + X;
  bmplength := 0;
  bmpBegin := Position - 1;
  h_seek (infile2, bmpBegin + 2,0);
  if (search.size-bmpbegin) > 4 then h_read (infile2, bmplength, SizeOf (bmplength) ); {Reads length of BMP}
  if (bmplength > 0) and ((bmpBegin +bmplength) <= search.size) Then
    begin
      ID:='BMP Picture';
      If SaveIt(ID,bmpbegin) then
        Begin
          writefile ('BMP',bmpbegin,BMPlength);
          written(ID,bmplength);
        End;
      clearline;
    end;
  settime(h,min,s,hund);
End;

Procedure writeFLIorC; {Extracts BMP files}
Var flibegin,flilength: LongInt;

Begin
  gettime(h,min,s,hund);
  Position := (l - res) + X;
  flilength := 0;
  fliBegin := Position - 5;
  h_seek (infile2, fliBegin,0);
  h_read(infile2,flilength,4);
  if (flilength > 0) and ((fliBegin + flilength) <= search.size) Then
    begin
      ID:='AutoDesk Animation';
      If SaveIt(ID,flibegin) then
        Begin
          writefile ('FLI',flibegin,flilength);
          written(ID,flilength);
        End;
      clearline;
    end;
   settime(h,min,s,hund);
End;

Procedure FoundWAVE; {Only detection of GIF}

var WaveLength,WaveBegin:longint;
    riff:array[1..4] of char;


Begin
  gettime(h,min,s,hund);
  clearline;
  Position := (l - res) + X;
  str(position-1,tempstring);
  if position >= 8 then begin
                         wavebegin:=position-9;
                         h_seek (infile2, wavebegin,0);
                         h_read(infile2,riff,4);
                         if riff='RIFF' then
                            begin
                            h_read(infile2,WaveLength,4);
                            WaveLength:=WaveLength+8;
                            if (wavelength > 0) and ((waveBegin + wavelength) <= search.size) Then
                            if abs(WaveLength)+abs(wavebegin) <= search.size then
                              begin
                                ID:='Windows Wave file';
                                If SaveIt(ID,WaveBegin) then
                                Begin
                                  writefile ('WAV',WaveBegin,WaveLength);
                                  written(ID,WaveLength);
                                End;
                                clearline;
                              end
                            end;
                        end;
  settime(h,min,s,hund);
End;

Procedure FoundGIF; {Only detection of GIF}
Begin
  gettime(h,min,s,hund);
  clearline;
  Position := (l - res) + X;
  str(position-1,tempstring);
  writeit ('GIF Picture detected at position: '+tempstring+' bytes.',2,14,121);
  waitforkey;
  settime(h,min,s,hund);
End;

Procedure FoundJPG; {Only detection of JPG}
Begin
  gettime(h,min,s,hund);
  clearline;
  Position := (l - res) + X;
  str(position-1,tempstring);
  writeit ('JPG Picture detected at position: '+tempstring+' bytes.',2,14,121);
  waitforkey;
  settime(h,min,s,hund);
End;

Procedure writeCustom(custom:string); {Detected the Custom Header}
var CustomBegin,CustomLength,offset:longint;
    number:string;
    i:byte;
Begin
  gettime(h,min,s,hund);
  clearline;
  Position := (l - res) + X;
  CustomBegin:=position;
  number:=option[3];
  offset:=0;
  if number[1]='$' then begin {It's an HEX value...}
                           for i:=2 to (length(number)) do
                           case number[i] of {This formula converts a HEX string to a longint}
                           '0'..'9':offset:=offset+(ORD(number[i])-$30)*trunc(exp((length(number)-i)*ln(16)));
                           'A'..'F':offset:=offset+(ORD(number[i])-$37)*trunc(exp((length(number)-i)*ln(16)));
                           end;
                         end
                    else begin {It's decimal...}
                            for i:=1 to (length(number)) do {And this converts a DECIMAL string to a longint}
                            offset:=offset+(ORD(number[i])-$30)*trunc(exp((length(number)-i)*ln(10)));
                         end;
  CustomBegin:= position-offset;
  Customlength := search.size - position;
  custom[1]:='(';
  ID:='Custom '+custom+') File';
  if SaveIt(ID,position) then
       Begin
         writefile ('TMP',custombegin,customlength);
         written(ID,customlength);
       End;
  clearline;
  settime(h,min,s,hund);
End;

Procedure PartialCopy; {Copies a part from x to y out of a file}
var number1,number2:string;
    copybegin,copyend:longint;
    i:byte;
Begin
  number1:=option[2]; {begin}
  number2:=option[3]; {end}
  copybegin:=0;
  copyend:=0;
  upper(number1);
  upper(number2);
  if number1[2]='$' then begin {It's an HEX value...}
                           for i:=3 to (length(number1)) do
                           case number1[i] of {This formula converts a HEX string to a longint}
                           '0'..'9':copybegin:=copybegin+(ORD(number1[i])-$30)*trunc(exp((length(number1)-i)*ln(16)));
                           'A'..'F':copybegin:=copybegin+(ORD(number1[i])-$37)*trunc(exp((length(number1)-i)*ln(16)));
                           end;
                         end
                    else begin {It's decimal...}
                            for i:=2 to (length(number1)) do {And this converts a DECIMAL string to a longint}
                            copybegin:=copybegin+(ORD(number1[i])-$30)*trunc(exp((length(number1)-i)*ln(10)));
                         end;
  case number2[1] of
  '$': {It's an HEX value...}
       for i:=2 to (length(number2)) do
         case number2[i] of
         '0'..'9':copyend:=copyend+(ORD(number2[i])-$30)*trunc(exp((length(number2)-i)*ln(16)));
         'A'..'F':copyend:=copyend+(ORD(number2[i])-$37)*trunc(exp((length(number2)-i)*ln(16)));
         end;
  'E': if (number2[2]='N') and (number2[3]='D') then copyend:=search.size;
  else {It's decimal...}
       for i:=1 to (length(number2)) do
          copyend:=copyend+(ORD(number2[i])-$30)*trunc(exp((length(number2)-i)*ln(10)));
  end;
  str(copybegin,tempstring);
  writeit(' Begin: '+tempstring,1,16,121);
  str(copyend,tempstring);
  writeit('   End: '+tempstring,1,17,121);
  if copybegin>search.size then SmoothExit;
  if copybegin >= copyend then SmoothExit;
  writefile('$$$',copybegin,(copyend-copybegin));
end;

procedure SearchExtended;assembler;

asm
        mov cx,res
        mov di,-1
@search:cmp cx,0
        jz @nothing
        dec cx
        inc di
        mov ah,byte ptr sample[di]
        mov al,byte ptr sample[di+1]
        cmp ax,11AFh
        jb @search
        cmp ax,'if'
        ja @search
@FLI:   cmp ax,11AFh
        ja @FLC
        jb @search
        mov x,di
        inc x
        push di
        push cx
        call WriteFLIorC
        pop cx
        pop di
        jmp @search
@FLC:   cmp ax,12AFh
        ja @BMP
        jb @search
        mov x,di
        inc x
        push di
        push cx
        call WriteFLIorC
        pop cx
        pop di
        jmp @search
@BMP:   cmp ax,'BM'
        ja @E669
        jb @search
        mov x,di
        inc x
        push di
        push cx
        call WriteBMP
        pop cx
        pop di
        jmp @search
@E669:  cmp ax,'JN'
        ja @669
        jb @search
        mov x,di
        inc x
        push di
        push cx
        call Write669
        pop cx
        pop di
        jmp @search
@669:   cmp ax,'if'
        jnz @search
        mov x,di
        inc x
        push di
        push cx
        call Write669
        pop cx
        pop di
        jmp @search
@nothing:
end;

procedure SearchCustom;
var custom:string;

begin
  custom:=option[2];
  for X:=0 to res do
     begin
       found:=0;
       for y:=1 to (ord(custom[0])-1) do
                                      if sample[X+Y]=custom[Y+1] then inc(found);
       if found=ord(custom[0])-1 then writeCustom(custom);
     end;
end;

procedure SearchEngine;assembler;
asm
        mov cx,res
        mov di,-1
@search:cmp cx,0
        jz @nothing
        dec cx
        inc di
        mov ah,byte ptr sample[di]
        mov al,byte ptr sample[di+1]
        mov bh,byte ptr sample[di+2]
        mov bl,byte ptr sample[di+3]
        cmp ax,'01'
        jb @search
        cmp ax,'ea'
        ja @search
        cmp bx,'CG'
        jb @search
        cmp bx,'te'
        ja @search

        cmp ax,'32'
        ja @CHN
        cmp bx,'CH'
        jnz @CHN
        mov x,di
        inc x
        sub ah,030h         {Convert chars in AX to normal word}
        sub al,030h
        mov dl,al
        mov al,ah
        xor ah,ah
        mov bl,10
        mul bl
        add al,dl
        shl ax,8
        mov patternsize,ax
        push di
        push cx
        call WriteMOD
        pop cx
        pop di
        jmp @search
@CHN:   cmp ah,'1'
        jb @search
        cmp ah,'9'
        ja @BMOD
        cmp al,'C'
        jnz @BMOD
        cmp bx,'HN'
        jnz @search
        mov x,di
        inc x
        shr ax,8
        sub al,030h
        shl ax,8
        mov patternsize,ax
        push di
        push cx
        call WriteMOD
        pop cx
        pop di
        jmp @search
@BMOD:  cmp ax,'2S'
        ja @AMF
        cmp bx,'TM'
        jnz @search
        mov x,di
        inc x
        push di
        push cx
        call WriteSTM
        pop cx
        pop di
        jmp @search
@AMF:   cmp ax,'AM'
        ja @DMF
        jb @search
        cmp bh,'F'
        jnz @search
        mov x,di
        inc x
        push di
        push cx
        call WriteAMF
        pop cx
        pop di
        jmp @search
@DMF:   cmp ax,'DD'
        ja @MDL
        jb @search
        cmp bx,'MF'
        jnz @search
        mov x,di
        inc x
        push di
        push cx
        call WriteDMF
        pop cx
        pop di
        jmp @search
@MDL:   cmp ax,'DM'
        ja @XM
        jb @search
        cmp bx,'DL'
        jnz @search
        mov x,di
        inc x
        push di
        push cx
        call WriteMDL
        pop cx
         pop di
        jmp @search
@XM:    cmp ax,'Ex'
        ja @FAR
        jb @search
        cmp bx,'te'
        jnz @search
        mov x,di
        inc x
        push di
        push cx
        call WriteXM
        pop cx
        pop di
        jmp @search
@FAR:   cmp ax,'FA'
        ja @FLT4
        jb @search
        cmp bx,'R■'
        jnz @search
        mov x,di
        inc x
        push di
        push cx
        call WriteFAR
        pop cx
        pop di
        jmp @search
@FLT4:  cmp ax,'FL'
        ja @LBM
        jb @search
        cmp bx,'T4'
        jnz @FLT8
        mov patternsize,1024
        mov x,di
        inc x
        push di
        push cx
        call WriteMOD
        pop cx
        pop di
        jmp @search
@FLT8:  cmp bx,'T8'
        jnz @search
        mov patternsize,2048
        mov x,di
        inc x
        push di
        push cx
        call WriteMOD
        pop cx
        pop di
        jmp @search
@LBM:   cmp ax,'FO'
        ja @GIF
        jb @search
        cmp bx,'RM'
        jnz @search
        mov x,di
        inc x
        push di
        push cx
        call WriteLBM
        pop cx
        pop di
        jmp @search
@GIF:   cmp ax,'GI'
        ja @JPG
        jb @search
        cmp bx,'F8'
        jnz @search
        mov x,di
        inc x
        push di
        push cx
        call FoundGIF
        pop cx
        pop di
        jmp @search
@JPG:   cmp ax,'JF'
        ja @MK2
        jb @search
        cmp bx,'IF'
        jnz @search
        mov x,di
        inc x
        push di
        push cx
        call FoundJPG
        pop cx
        pop di
        jmp @search
@MK2:   cmp ax,'M!'
        ja @MK1
        jb @search
        cmp bx,'K!'
        jnz @search
        mov patternsize,1024
        mov x,di
        inc x
        push di
        push cx
        call WriteMOD
        pop cx
        pop di
        jmp @search
@MK1:   cmp ax,'M.'
        ja @ULT
        jb @search
        cmp bx,'K.'
        jnz @search
        mov patternsize,1024
        mov x,di
        inc x
        push di
        push cx
        call WriteMOD
        pop cx
        pop di
        jmp @search
@ULT:   cmp ax,'MA'
        ja @MTM
        jb @search
        cmp bx,'S_'
        jnz @search
        mov x,di
        inc x
        push di
        push cx
        call WriteULT
        pop cx
        pop di
        jmp @search
@MTM:   cmp ax,'MT'
        ja @OCTA
        jb @search
        cmp bh,'M'
        jnz @MIDI
        mov x,di
        inc x
        push di
        push cx
        call WriteMTM
        pop cx
        pop di
        jmp @search
@MIDI:  cmp bx,'hd'
        jnz @search
        mov x,di
        inc x
        push di
        push cx
        call WriteMIDI
        pop cx
        pop di
        jmp @search
@OCTA:  cmp ax,'OC'
        ja @PAC
        jb @search
        cmp bx,'TA'
        jnz @search
        mov patternsize,2048
        mov x,di
        inc x
        push di
        push cx
        call WriteMOD
        pop cx
        pop di
        jmp @search
@PAC:   cmp ax,'PA'
        ja @PTM
        jb @search
        cmp bx,'CG'
        jnz @search
        mov x,di
        inc x
        push di
        push cx
        call WritePAC
        pop cx
        pop di
        jmp @search
@PTM:   cmp ax,'PT'
        ja @S3M
        jb @search
        cmp bx,'MF'
        jnz @search
        mov x,di
        inc x
        push di
        push cx
        call WritePTM
        pop cx
        pop di
        jmp @search
@S3M:   cmp ax,'SC'
        ja @WAV
        jb @search
        cmp bx,'RM'
        jnz @search
        mov x,di
        inc x
        push di
        push cx
        call WriteS3M
        pop cx
        pop di
        jmp @search
@WAV:   cmp ax,'WA'
        ja @STM2
        jb @search
        cmp bx,'VE'
        jnz @search
        mov x,di
        inc x
        push di
        push cx
        call FoundWAVE
        pop cx
        pop di
        jmp @search
@STM2:  cmp ax,'eP'
        ja @STM
        jb @search
        cmp bx,'ro'
        jnz @search
        mov x,di
        inc x
        push di
        push cx
        call WriteSTM
        pop cx
        pop di
        jmp @search
@STM:   cmp ax,'ea'
        jnz @search
        cmp bx,'m!'
        jnz @search
        mov x,di
        inc x
        push di
        push cx
        call WriteSTM
        pop cx
        pop di
        jmp @search
@nothing:
end;

Begin {Main Program}
  if IsVga then
    begin
      total:=0;
      asm push cs end; {Well...this seems to be a HUGE error in TP}
      SetFont;
      CursorOff;
      filenum:=0;
      GetMem(pFileName,80);
        begin
          GetTime(h,min_old,s_old,hund_old);
          If (GetArgCount = 0) Then begin
                                      DisplayHelp;
                                      if option[1] = #0 then SmoothExit;
                                    end
                               Else begin
                                      GetMem(pP,80); {Reserve some memory for commandline string}
                                      GetArgStr(pP,1,80);  {Filename, specified at commandline}
                                      option[1]:=Str2Pas(PP);
                                      GetArgStr(PP,2,80);  {Filename, specified at commandline}
                                      option[2]:=Str2Pas(PP);
                                      GetArgStr(PP,3,80);  {Filename, specified at commandline}
                                      option[3]:=Str2Pas(PP);
                                    end;
          for y:=2 to 25 do for x:=1 to 80 do writeit(' ',x,y,112); {Clearscreen, not fast, but easy}
          writeit (' Fast Module Extractor 2.0                                       ■TWC■ (c) 1995 ',1,1,79);
          writeit ('                  The easy way to extract music and graphics                    ',1,25,30);
          drawline(13,125);
          drawline (15,117);
          PP:=Pas2PChar(option[1]);
          doserror:=FindFirst (PP, 0, Search);
          FileSplit (PP, D, N, E);
          filename:=Str2Pas(D);
          filename:=filename+Search.Name;
          if option[2,1]='#' then
            begin
              writeit(' Working in partial copy mode',1,19,113);
              writeit(' Copying from: '+ search.name,1,21,113);
              Pfilename:=Pas2PChar(filename);
              infile2:=h_Openfile(PFilename,0);
              PartialCopy;
              h_closefile(infile2);
              waitforkey;
          end
          else
          if doserror=0 then
            begin
              While DosError = 0 Do
                begin
                  upper(filename);
                  Pfilename:=Pas2PChar(filename);
                  infile1:=h_Openfile(PFilename,0);
                  Attr:=GetFileAttr(Pfilename);
                  if Attr and faReadOnly <> 0 then begin
                                                     Readonlyfile := True; {Remove read-only attr}
                                                     SetFileAttr(pas2pchar(filename), faArchive);
                                                   end
                  else Readonlyfile := False;
                      infile2:=h_Openfile(PFilename,0);
                      l := 0;
                      position := 0;
                      writeit('Filename: '+str2pas(pfilename)+'                     ',34,5,127);
                      writeit(' Starting time: '+leadingzero(h)+':'+leadingzero(min_old)+':'+leadingzero(s_old),1,20,127);
                      for Y := 1 to 25 do writeit ('▒',1+Y,5,112);
                      res:=0;
                      if search.size > 0 then
                        repeat
                          res:=h_read (infile1, sample, SizeOf (sample));
                          l:=l+res;
                          str(l:7,tempstring);
                          writeit ('Processing: '+tempstring,2,3,121);
                          str(search.size:7,tempstring);
                          writeit (' bytes of '+tempstring+' bytes.      ',21,3,121);
                          str(total,tempstring);
                          writeit (' Total scanned: '+tempstring+' bytes',1,22,127);
                          drawbar(l * 100 Div search.size,5);
                          case option[2,1] of
                          'X','x': begin
                                     writeit ('┤Extended mode├',65,15,117);
                                     SearchExtended;
                                   end;
                          '!':     begin
                                     writeit ('┤Custom mode├',67,15,117);
                                     SearchCustom;
                                   end;
                          end;
{----------------------------------------------------------------------------}
                          SearchEngine; {The central search-engine!}
{----------------------------------------------------------------------------}
                          Total:=Total+res;
                          if port[$60]=1 then SmoothExit; {Quick-escape...}
                        until res < buffer;
                      if readonlyfile Then Attr:=SetFileAttr(pas2pchar(filename), faReadonly+faArchive);
                      h_CloseFile(infile1);
                      h_CloseFile(infile2);
                      doserror:=FindNext(search);
                      filename:=Str2Pas(D);
                      filename:=filename+Search.Name;
                end;
              gettime(h,min,s,hund);
              writeit('Ending time: '+leadingzero(h)+':'+leadingzero(min)+':'+leadingzero(s),4,21,127);
              thetime:=((hund/100) + (min / 60) + s) - ((hund_old/100) + (min_old / 60) + s_old);
              str(thetime:2:2,tempstring);
              writeit(' Total scanning time: '+tempstring+' seconds',1,23,122);
              str(((Total / 1024) / thetime):2:2,tempstring);
              writeit('      Speed:  '+tempstring+' kb/s',40,23,122);
              writeit('Scan completed',2,14,121);
              waitforkey;
            end
          else
            begin
              writeit(' File not found',2,14,121);
              readkey;
            end;
        end
    end
  else writeit('This program requires VGA',1,1,7);
  SmoothExit;
End.