home *** CD-ROM | disk | FTP | other *** search
/ Gambler 19 / GAMBLERCD19.BIN / UTILS / DDTPACK / PROGS / FM-EXT / SOURCE / FM-EXT.PAS < prev    next >
Pascal/Delphi Source File  |  1996-01-01  |  74KB  |  2,460 lines
  1. Program Fast_Module_Extractor;
  2.  
  3. {$L FONT.OBJ}
  4.  
  5. {$DEFINE DEBUG} {Disable to compile release version}
  6.  
  7. Uses EnhDOS, Strings;
  8.  
  9. Const Buffer = 32767;              {Size of search-buffer           }
  10.       version = '2.1 ';            {Version-number, must be 4 chars!}
  11.  
  12. Type bytearray = Array [0..Buffer] Of char;
  13.      CharSet = Set OF Char;
  14.  
  15. Var
  16.   header                    :array[1..4] of char;
  17.   option                    :array[1..3] of string;
  18.   sample                    :bytearray;
  19.   doserror                  :integer;
  20.   attr, found, res,
  21.   FilesInDir, patternsize, x, y,fx    :word;
  22.   FileNum,l                 :longint;
  23.   infile1, infile2          :byte;
  24.   ID,filename               :string;
  25.   pP,pFileName              :pchar;
  26.   Search                    :tsearchrec;
  27.   D                         :tdirstr;
  28.   N                         :tnamestr;
  29.   E                         :textstr;
  30.   AutoMode,ReadOnlyFile     :boolean;
  31.   TheTime                   :real;
  32.  
  33.  
  34. Procedure Setfont;external;
  35. {Changes the textmode font to the one defined in FONT.OBJ
  36.    input: -
  37.   output: - }
  38.  
  39. Function IsVGA: boolean;assembler;
  40. {Checks for a VGA-card
  41.    input: -
  42.   output: IsVGA         - boolean : True when VGA found
  43.                                     False when no VGA found}
  44. asm
  45.    xor     bx,bx
  46.    mov     ax,01A00h
  47.    int     010h
  48.    mov     ax,1
  49.    cmp     bl,7
  50.    jnc     @@ok
  51.    cmp     bl,8
  52.    jnc     @@ok
  53.    xor     ax,ax
  54. @@ok:
  55. end;
  56.  
  57. Function TestBit(x,bits:byte):boolean;assembler;
  58. asm
  59.   xor ax,ax
  60.   mov bl,x
  61.   test bl,bits
  62.   jz @false
  63.   mov ax,1
  64. @false:
  65. end;
  66.  
  67. procedure ClrScr;assembler;
  68.   asm
  69.     mov ax,0B800h
  70.     mov es,ax
  71.     mov di,0h
  72.     mov cx,80*25
  73.     mov ax,0700h
  74.     cld
  75.     rep stosw
  76.   end;
  77.  
  78. function ReadKey:char;assembler;
  79. {Reads a key from the keyboard via the BIOS
  80.    input: -
  81.   output: ReadKey         - char : value from keyboard}
  82.  
  83. asm
  84.    xor ah,ah
  85.    int 16h
  86.    {The function 'readkey' returns the value in AL}
  87. end;
  88.  
  89. Procedure FastWrite(s:string;x,y:word;Attr:byte);assembler;
  90. {Writes a string directly to the textscreen; Color only
  91.    input: s               - string : string to display
  92.           x               - word   : column
  93.           y               - word   : row
  94.           Attr            - byte   : attribute for string
  95.   output: -                                   }
  96.  
  97. asm
  98.    push ds            {TP7 doesn't save DS    }
  99.    mov ax,y           {Get row                }
  100.    dec ax             {Convert to zero-based  }
  101.    mov dx,80          {80 columns             }
  102.    mul dx             {Multiply row with 80   }
  103.    dec ax             {Convert to zero-based  }
  104.    add ax,x           {Get column             }
  105.    shl ax,1           {Multiply by 2          }
  106.    mov si,ax          {Save it in SI          }
  107.  
  108.    mov ax,0B800h      {Value of text-segment  }
  109.    mov es,ax          {Save it in ES          }
  110.    xor cx,cx          {Clear CX               }
  111.    lds di,s           {Load location of string}
  112.    mov cl,ds:[di]     {Get length of string   }
  113.    mov bh,attr        {Get attribute          }
  114.  
  115. @w:inc di             {Increment DI           }
  116.    mov bl,ds:[di]     {Get next char of string}
  117.    mov es:[si],bx     {Put on the screen      }
  118.    inc si             {Increment SI twice     }
  119.    inc si
  120.    loop @w            {Loop CX times          }
  121.    pop ds             {Pop DS back            }
  122. end;
  123.  
  124. Procedure cursoroff;assembler;
  125. {Turns cursor off
  126.    input: -
  127.   output: -      }
  128. asm
  129.    mov   ax,0100h
  130.    mov   cx,2607h
  131.    int   10h
  132. end;
  133.  
  134. Procedure cursoron;assembler;
  135. {Turns cursor on
  136.    input: -
  137.   output: -      }
  138. asm
  139.     mov   ax,0100h
  140.     mov   cx,0506h
  141.     int   10h
  142. end;
  143.  
  144. Procedure Upper(var s: string);assembler;
  145. {Converts a string to uppercase-chars
  146.    input: s               - string : string to convert
  147.   output: s               - string : converted string    }
  148.  
  149. asm
  150.    push    ds              { Save DS on stack }
  151.    lds     si, S           { Load DS:SI With Pointer to S }
  152.    cld                     { Clear direction flag - String instr. Forward}
  153.    lodsb                   { Load first Byte of S (String length Byte) }
  154.    sub     ah, ah          { Clear high Byte of AX }
  155.    mov     cx, ax          { Move AX in CX }
  156.    jcxz    @Done           { Length = 0, done }
  157.    mov     ax, ds          { Set ES to the value in DS through AX }
  158.    mov     es, ax          { (can't move between two segment Registers) }
  159.    mov     di, si          { DI and SI now point to the first Char. }
  160. @UpCase:
  161.    lodsb                   { Load Character }
  162.    cmp     al, 'a'
  163.    jb      @notLower       { below 'a' -- store as is }
  164.    cmp     al, 'z'
  165.    ja      @notLower       { above 'z' -- store as is }
  166.    sub     al, ('a' - 'A') { convert Character in AL to upper Case }
  167. @notLower:
  168.    stosb                   { Store upCased Character in String }
  169.    loop    @UpCase         { Decrement CX, jump if not zero }
  170. @Done:
  171.    pop     ds              { Restore DS from stack }
  172. end;
  173.  
  174. Procedure ClearLine;
  175. {Clears the statusline
  176.    input: -
  177.   output: -      }
  178. begin
  179.   FastWrite('                                                                               ',1,14,112);
  180. end;
  181.  
  182. function ToStr(n:longint;i:byte):string;
  183. var t:string;
  184. begin
  185.   Str(n:i,t);
  186.   ToStr:=t;
  187. end;
  188.  
  189. Function GetString(cx,cy,cc,pc:byte;default,prompt:string;MaxLen:integer;OKSet :charset):string;
  190. {Get a string from the keyboard, very sophisticated!
  191.    input: cx              - byte   : column for input
  192.           cy              - byte   : row for input
  193.           cc              - byte   : attribute for input
  194.           pc              - byte   : attribute for prompt
  195.           default         - string : default input-string
  196.           prompt          - string : prompt
  197.           MaxLen          - integer: maximum length of input
  198.           OkSet           - charset: allowed characters
  199.   output: GetString       - string : returns given string}
  200.  
  201. const
  202.   BS                 = #8;
  203.   CR                 = #13;
  204.   ESC                = #27;
  205.   iPutChar           = #249;
  206.   ConSet             : CharSet = [BS,CR,ESC];
  207. var
  208.   TStr:string;
  209.   x,i,tlen:byte;
  210.   Ch:char;
  211.  
  212. begin
  213.   TStr := '';
  214.   TLen := 0;
  215.   FastWrite(prompt,cx,cy,pc);
  216.   x := cx + ord(Prompt[0]);
  217.   For i := x to (x + Maxlen - 1) do FastWrite(iputChar,i,cy,cc);
  218.   if default<>'' then FastWrite(default,x,cy,cc);
  219.   OKSet := OKSet + ConSet;
  220.   cursoron;
  221.   repeat
  222.     asm
  223.       mov ah,2
  224.       mov dh,cy
  225.       dec dh
  226.       mov dl,x
  227.       dec dl
  228.       mov bh,0
  229.       int 10h
  230.     end;
  231.     repeat
  232.        ch:=readkey
  233.     until ch in OKSet;
  234.     if tlen=0 then for i := x to (x + ord(default[0])) do FastWrite(iputChar,i,cy,cc);
  235.     case ch of
  236.     BS: begin
  237.           if TLen > 0 then begin
  238.                              dec(TLen);
  239.                              dec(x);
  240.                              FastWrite(iPutChar,x,cy,cc);
  241.                            end;
  242.         end;
  243.     else if (Ch<>CR) and (Ch<> ESC) and (TLen < MaxLen) then
  244.          begin
  245.            FastWrite(Ch,x,cy,cc);
  246.            inc(TLen);
  247.            TStr[TLen] := Ch;
  248.            inc(X);
  249.          end;
  250.     end;
  251.   until (Ch = CR) or (Ch = ESC);
  252.   If Tlen > 0 Then Begin
  253.                      TStr[0] := chr(Tlen);
  254.                      Getstring := TStr
  255.                    End
  256.   Else Getstring := Default;
  257.   cursoroff;
  258.   clearline;
  259. end;
  260.  
  261.  
  262. Procedure DrawLine(Line: integer;color:byte);
  263. {Draw a line at a given position and in a given color
  264.    input: line            - integer: row to draw the line
  265.           color           - byte   : attribute for line
  266.   output: -                                   }
  267.  
  268. var i: Integer;
  269. begin
  270.   FastWrite('■',1,line,color);
  271.   For i := 2 To 79 Do FastWrite('─',i,line,color);
  272.   FastWrite('■',80,line,color);
  273. End;
  274.  
  275. procedure drawbar(m,column,line:byte);
  276. {Draw a percentage-bar at a given position
  277.    input: m               - byte   : percentage to display (0..100%)
  278.           line            - byte   : row to display bar
  279.   output: -                                   }
  280.  
  281. var tmp:string;
  282. begin
  283.   For Y := 2 To (m+1) Do
  284.   Begin
  285.     FastWrite('█',column+(Y shr 2),line,126);
  286.     Str(m:3,tmp);
  287.     FastWrite(' '+tmp+'%  ',column+25,line,126);
  288.   End;
  289. End;
  290.  
  291. function IntelLong(motorola:LongInt):LongInt;assembler;
  292. {Converts a Motorola DWORD to a Intel DWORD
  293.    input: motorola        - longint: motorola DWORD
  294.   output: intellong       - longint: intel DWORD    }
  295.  
  296. asm
  297.    mov  ax,[word ptr motorola]
  298.    mov  dx,[word ptr motorola+2]
  299.    xchg al,ah
  300.    xchg dl,dh
  301.    xchg ax,dx
  302. end;
  303.  
  304. procedure SmoothExit;
  305. {Scroll the screen up (SMOOTH) and exit to OS
  306.    input: -
  307.   output: -      }
  308. var i,vel:word;
  309. begin
  310.   i:=0;
  311.   vel:=0;
  312.   REPEAT {Credits to VangeliSTeam for this code!}
  313.       WHILE (Port[$3DA] AND 8) =  8 DO;
  314.       asm cli end;
  315.       Port[$3d4] := $c; Port[$3d5] := HI((i DIV 16)*80);
  316.       Port[$3d4] := $d; Port[$3d5] := LO((i DIV 16)*80);
  317.       WHILE (Port[$3DA] AND 8) <> 8 DO
  318.       Port[$3d4] := 8; Port[$3d5] := (Port[$3d5] AND $E0) OR (i AND $0F);
  319.       asm
  320.           sti
  321.           add vel,10
  322.       end;
  323.       i := i + (vel shr 4);
  324.   UNTIL i >= 25*16;
  325.   CursorOn;
  326.   asm
  327.    mov ax,3h
  328.    int 10h
  329.   end;
  330.   ClrScr;
  331.   Halt;
  332. end;
  333.  
  334. Procedure waitforkey;
  335. {Wait for a key-press
  336.    input: -
  337.   output: -          }
  338. begin
  339.   FastWrite('■',2,18,252);
  340.   if Readkey=#27 then SmoothExit
  341.                  else clearline;
  342.   FastWrite(' ',2,18,112)
  343. End;
  344.  
  345. Function SaveIt(s:string;position:longint):boolean;
  346. {Asks the user to save a file
  347.    input: s               - string : type of file to save
  348.           position        - longint: position of found file
  349.   output: SaveIt          - boolean: True when user wants to save else false}
  350.  
  351. begin
  352.   if AutoMode=False then
  353.   begin
  354.     clearline;
  355.     FastWrite (s+' found at position '+ToStr(position,0)+'. Save it (Y/n/a)?',2,14,121);
  356.     Case ReadKey of
  357.         #13,'y','Y': SaveIt:=True;
  358.             'a','A': begin
  359.                        SaveIt:=True;
  360.                        AutoMode:=True;
  361.                      end;
  362.                 #27: SmoothExit;
  363.     else begin
  364.            SaveIt:=False;
  365.            FastWrite('                                               ',2,11,121);
  366.          end;
  367.     End;
  368.     clearline;
  369.  
  370.   end
  371.   else SaveIt:=True;
  372. end;
  373.  
  374. Procedure WriteFile (ext:string;filebegin,filelength: LongInt);
  375. {Copies a part from a file to another file
  376.    input: ext             - string : extension for new file
  377.           filebegin       - longint: startposition in old file
  378.           filelength      - longint: length of new file
  379.   output: -                                   }
  380.  
  381. Var filelengthstr,fileout:string;
  382.   outfile: byte;
  383.   err:word;
  384.   pfileout:pchar;
  385.   writebuffer: Array [1..32768] Of Byte;
  386.   numread,buffers: Integer;
  387.   temp:char;
  388.   e,i: LongInt;
  389.   continue:boolean;
  390.   OldSearchRec:TSearchRec;
  391.  
  392. Begin
  393.   GetMem(pFileOut,80);
  394.   OldSearchRec:=Search;
  395.   repeat
  396.     continue:=true;
  397.     clearline;
  398.     cursoron;
  399.     inc(filenum);
  400.     if AutoMode = False then fileout:=GetString(2,14,121,121,ToStr(filenum,0)+'.'+ext,'Enter filename: ',62,['!'..'~'])
  401.                         else fileout:=ToStr(filenum,0)+'.'+ext;
  402.     pfileout:=pas2pchar(fileout);
  403.     if existsfile(pfileout) then
  404.       begin
  405.         cursoroff;
  406.         if AutoMode = False then begin
  407.                                    FastWrite('File already exists. Overwrite it ['+fileout+'] (Y/n)',2,14,121);
  408.                                    temp:=readkey;
  409.                                    if (temp=#78) or (temp=#110) then continue:=false
  410.                                                                 else continue:=true
  411.                                  end
  412.                             else continue:=true;
  413.         clearline;
  414.         DeleteFile(pfileout);
  415.       end;
  416.    until continue;
  417.   if Abs(DiskFree(0))<Filelength then begin
  418.                                      FastWrite('Disk full; Cannot save file',2,14,121);
  419.                                      waitforkey;
  420.                                      continue:=false;
  421.                                     end
  422.                                  else
  423.   begin
  424.   cursoroff;
  425.   err:=h_LSeek(infile2,filebegin,0);
  426.   outfile:=h_Createfile(pfileout);
  427.   buffers:=(filelength div sizeof(writebuffer));
  428.   str(filelength:9,filelengthstr);
  429.   for i:=1 to buffers do
  430.     begin
  431.       h_read(infile2,writebuffer,sizeof(writebuffer));
  432.       h_write(outfile,writebuffer,sizeof(writebuffer));
  433. {      str(4096*i:9,tempstring);}
  434.       FastWrite('Processing: '+ToStr(32768*i,9)+' bytes of '+filelengthstr+' bytes',2,9,121);
  435.       drawbar((100*32768*i) div filelength,50,9);
  436.     end;
  437.   h_read(infile2,writebuffer,filelength-(32768*buffers));
  438.   h_write(outfile,writebuffer,filelength-(32768*buffers));
  439.   FastWrite(' Processing: '+filelengthstr+' bytes of '+filelengthstr+' bytes',1,9,121);
  440.   drawbar(100,50,9);
  441.   h_closefile(outfile);
  442.   for i:=50 to 50+24 do FastWrite('▒',i,9,112);
  443.   FastWrite('   ',76,9,121);
  444.   FastWrite('                                               ',2,11,121);
  445.   FastWrite(' Processing:           bytes of           bytes',1,9,121);
  446.   Search:=OldSearchRec;
  447.   end;
  448. End;
  449.  
  450. Procedure DisplayHelp;
  451. {Displays help-screen and asks commandline
  452.    input: -
  453.   output: -          }
  454.  
  455. var i,o:byte;
  456.     tmp:string;
  457. begin;
  458.     for x:=1 to 80 do FastWrite(' ',x,1,79);
  459.     FastWrite (' Fast Module Extractor '+version,1,1,79);
  460.     for x:=2 to 25 do for y:=1 to 80 do FastWrite(' ',y,x,112);
  461.     FastWrite (' Usage: FM-EXT filename <options>',1,3,126);
  462.     FastWrite (' Extracts: MOD, STM, S3M, 669, MTM, AMF, PAC, DSM, FNK, GDM',1,6,121);
  463.     FastWrite ('           FAR, ULT, MDL, PTM, DMF, UNI, PSM, AMS, MXM, XM',1,7,121);
  464.     FastWrite ('           MID, XMI, HMP, MUS, CMF, SAT, SA2, RAD, D00, DLZ',1,8,121);
  465.     FastWrite ('           WAV, VOC, 8SX, AIF, SBK, AU',1,9,121);
  466.     FastWrite ('           BMP, LBM, SCX, PCX, GIF, JPG',1,10,121);
  467.     FastWrite ('           FLI, FLC, AVI, ANM, MOV',1,11,121);
  468.     FastWrite (' Wildcards allowed!',1,15,124);
  469.     FastWrite ('  Options: X                Turn on 669, FLI, FLC searching',1,17,120);
  470.     FastWrite ('           !<ABCD> <offset> Custom header search (1..255 chars!)',1,18,120);
  471.     FastWrite ('           #<begin> <end>   Partial copy mode',1,19,120);
  472.     FastWrite (' See DOCs for details',1,21,127);
  473.     drawline(23,125);
  474.     drawline(25,117);
  475.     tmp:=GetString(2,24,7,7,'','>FM-EXT ',70,[' '..#255]);
  476.     pp:=Pas2PChar(tmp);
  477.     i:=0;
  478.     for x:=1 to 3 do
  479.     begin
  480.       if pp[i]=' 'then
  481.          repeat inc(i) until pp[i]<>' ';
  482.       o:=1;
  483.       repeat
  484.         option[x,o]:=pp[i];
  485.         inc(i);
  486.         inc(o);
  487.       until (pp[i]=' ') or (pp[i]=#0);
  488.       option[x,0]:=chr(o-1);
  489.     end;
  490. End;
  491.  
  492. Procedure write669;
  493. {Checks for ComposD 669 files
  494.    input: -
  495.   output: -          }
  496.  
  497. Var title669: Array [1..108] Of Char;
  498.   nos, nop: Byte;
  499.   sample: Word;
  500.   begin669,temp,Length669, i: LongInt;
  501.  
  502. Begin
  503.   Begin669 := (l - res) + X;  {Calculate 669 beginning}
  504.   Length669 := 0;
  505.   If (search.size - Begin669) > 110 Then
  506.     begin
  507.       h_LSeek (infile2, Begin669 + 2,0);
  508.       h_Read (infile2, title669, SizeOf (title669) );
  509.       h_LSeek(infile2, Begin669 + 110,0);
  510.       h_Read (infile2, nos,SizeOf (nos) ); {Read # of samples}
  511.       h_Read (infile2, nop,SizeOf (nop) ); {Read # of patterns}
  512.       h_LSeek (infile2, begin669 + 510,0);
  513.       For i := 1 To nos Do
  514.         Begin              {Read NOS times the sample lengths}
  515.           h_Read (infile2, sample, SizeOf (sample) );
  516.           h_LSeek (infile2, (begin669 + 510) + (i * $19),0 );
  517.           Length669 := Length669 + sample;
  518.         End;
  519.       temp:=nop;
  520.       Length669 := Length669 + (temp * 1536);
  521.       temp:=nos;
  522.       Length669 := Length669 + (temp * $19) +$1F1; {Calculate total length}
  523.       if (length669 > 0) and ((Begin669 +length669) <= search.size) Then
  524.       begin
  525.         FastWrite ('Title: ',2,11,113);
  526.         For i := 1 To 36 Do FastWrite (title669 [i],39+i,9,113);
  527.         ID:='669 File';
  528.         if SaveIt(ID,begin669) then writefile ('669',begin669,Length669);
  529.         FastWrite('                                             ',39,10,113);
  530.         FastWrite('                                             ',39,11,113);
  531.       end;
  532.     end;
  533. End;
  534.  
  535. Procedure writeS3M;
  536. {Checks for ScreamTracker 3.x  files
  537.    input: -
  538.   output: -          }
  539.  
  540. Var titleS3M: Array [1..28] Of Char;
  541.   noo, nos, nop: Word;
  542.   sample: Word;
  543.   memseg: Word;
  544.   i,begins3m, lengths3m, memsegold, Length: LongInt;
  545.   t: Byte;
  546.  
  547. Begin
  548.   lengths3m := 0;
  549.   memsegold := 0;
  550.   Begins3m := (l - res) + X - 44;
  551.   h_LSeek (infile2, Begins3m,0);
  552.   h_read (infile2, titleS3M, SizeOf (titleS3M) ); {Read title}
  553.   h_LSeek (infile2, Begins3m + 32,0);
  554.   h_read (infile2, noo, SizeOf (noo) ); {Read # of orders}
  555.   h_read (infile2, nos, SizeOf (nop) ); {Read # of patterns}
  556.   h_read (infile2, nop, SizeOf (nos) ); {Read # of samples}
  557.   h_LSeek (infile2, begins3m + 96 + noo,0);
  558.   if (nos <> 0) and (nos < 100) then For i := 0 To nos - 1 Do                 {Read NOS times the pointers to all samples}
  559.     Begin
  560.       h_LSeek (infile2, begins3m + 96 + noo + i + i,0);
  561.       h_read (infile2, sample, SizeOf (sample) );
  562.       h_LSeek (infile2, 14 + begins3m + (sample * 16) ,0);
  563.       h_read (infile2, memseg, SizeOf (memseg) );
  564.       If memseg > memsegold Then
  565.         Begin
  566.           memsegold := memseg;
  567.           h_read (infile2, Length, SizeOf (Length) ); {Read last sample length}
  568.           lengths3m := (memsegold * 16) + Length;        {Add last sample length and last filepointer}
  569.         End;
  570.       End;
  571.   if (lengths3m > 0) and ((Begins3m +lengths3m) <= search.size) Then
  572.   begin
  573.     ID:='ScreamTracker 3.0';
  574.     FastWrite ('Title: '+ titleS3M,2,11,113);
  575.     if SaveIt(ID,BeginS3M) then writefile ('S3M',begins3m,lengths3m);
  576.   end;
  577. End;
  578.  
  579. Procedure writeMTM; {Extracts MultiTracker 1.x files}
  580. {Checks for MultiTracker 1.x files
  581.    input: -
  582.   output: -          }
  583.  
  584.  
  585. Var titleMTM: Array [1..20] Of Char;
  586.   lps, nos: Byte;
  587.   loc, trks: Word;
  588.   i,beginmtm, lengthmtm, sample: LongInt;
  589.  
  590. Begin
  591.   BeginMTM := (l - res) + X;
  592.   lengthmtm := 0;
  593.   If (search.size - BeginMTM) > 100 Then
  594.     begin
  595.       h_LSeek (infile2, Beginmtm + 4,0);
  596.       h_read (infile2, titleMTM, SizeOf (titleMTM) ); {Read title}
  597.       h_LSeek (infile2, Beginmtm + 24,0);
  598.       h_read (infile2, trks, SizeOf (trks) ); {Read # of tracks}
  599.       h_read (infile2, lps, SizeOf (lps) );   {Read # of ?}
  600.       h_LSeek (infile2, beginmtm + 28,0);
  601.       h_read (infile2, loc, SizeOf (loc) );
  602.       h_read (infile2, nos, SizeOf (nos) );   {Read # of samples}
  603.       lengthMTM := (194 + (nos * 37) + (trks * 192) + ( (lps + 1) * 32 * 2) + loc);
  604.       h_LSeek (infile2, beginMTM + 88,0);
  605.       For i := 1 To nos Do
  606.          begin
  607.            h_read (infile2, sample, SizeOf (sample) );
  608.            h_LSeek (infile2, (beginmtm + 88) + (i * 37) ,0);
  609.            lengthMTM := lengthMTM + sample;
  610.          end;
  611.       if (lengthmtm > 0) and ((Beginmtm + lengthmtm) <= search.size) Then
  612.         begin
  613.           FastWrite('Title: '+titleMTM,2,11,113);
  614.           ID:='MultiTracker Module';
  615.           if SaveIt(ID,beginmtm) then writefile ('MTM',beginmtm,lengthmtm);
  616.         end;
  617.     end;
  618. End;
  619.  
  620. Procedure WriteMOD;{(patternsize: word); {Flexible MOD file extractor}
  621. {Checks for MOD-type files (1..32 channel
  622.    input: -
  623.   output: -          }
  624.  
  625. Var i, modbegin,modlength: LongInt;
  626.     title: Array [1..20] Of Char;
  627.     Pattern: Array [1..128] Of Byte;
  628.     number,laag, hoog: Byte;
  629.  
  630. Begin
  631.   MODBegin := (l - res) + X - 1080;
  632.   number:=0;
  633.   modlength := 0;
  634.   if (ModBegin >= 0) and (patternsize <= 32*256) then
  635.     begin
  636.       h_LSeek (infile2, ModBegin,0);
  637.       h_read (infile2, title, SizeOf (title) ); {Reads title}
  638.       h_LSeek (infile2, ModBegin + 42,0);
  639.       For i := 1 To 31 Do  {Reads sample sizes}
  640.          Begin
  641.            h_read (infile2, hoog, SizeOf (hoog) );
  642.            h_read (infile2, laag, SizeOf (laag) );
  643.            h_LSeek (infile2, ModBegin + 42 + (i * 30) ,0);
  644.            modlength := modlength + ( (hoog * 256) + laag);
  645.          End;
  646.       modlength := modlength * 2;
  647.       h_LSeek (infile2, Modbegin + 952,0);
  648.       h_read (infile2, Pattern, 128); {Reads pattern order, highest number -> number of patterns}
  649.       For i := 1 To 128 Do If number < Pattern [i] Then number := Pattern [i];
  650.       i:=patternsize; {Must convert patternsize to longint...causes otherwise an FP error}
  651.       modlength := modlength + ( (number + 1)* i) + 1084;
  652.       h_LSeek (infile2, ModBegin,0);
  653.       if (modlength > 1081) and ((ModBegin +Modlength) <= search.size) Then
  654.         begin
  655.           FastWrite('Title: '+ title,2,11,113);
  656.           ID:=ToStr(patternsize div 256,0)+' Channel MOD File';
  657.           if SaveIt(ID,ModBegin) then writefile('MOD',modbegin,modlength);
  658.        end;
  659.     end;
  660. End;
  661.  
  662. Procedure writeSTM; {Extracts ScreamTracker 2.x / BMOD2STM / SWavePro files}
  663.  
  664. Var i, beginstm,stmlength: LongInt;
  665.   header: array[1..8] of Char;
  666.   title: Array [1..20] Of Char;
  667.   los: Word;
  668.   nop: Byte;
  669.  
  670. Begin
  671.   BeginSTM := (l - res) + X - 24;
  672.   stmlength := 0;
  673.   h_LSeek (infile2, Beginstm + $14,0);
  674.   h_read (infile2, header, SizeOf(header));
  675.   if (header='!Scream!') or (header='BMOD2STM') or (header='SWavePro') then
  676.   begin
  677.       h_LSeek (infile2, Beginstm,0);
  678.       h_read (infile2, title, SizeOf (title) );
  679.       h_LSeek (infile2, Beginstm + 33,0);
  680.       h_read (infile2, nop, SizeOf (nop) ); {Read # of patterns}
  681.       h_LSeek (infile2, Beginstm + 64,0);
  682.       stmlength := nop;
  683.       stmlength := stmlength * 1024;
  684.       For i := 1 To 31 Do
  685.       Begin
  686.         h_read (infile2, los, SizeOf (los) );
  687.         h_LSeek (infile2, Beginstm + 64 + (i * 32) ,0);
  688.         If (los mod 16) <> 0  Then los := 16*(los Div 16);
  689.         stmlength := stmlength + los;
  690.       End;
  691.      stmlength := stmlength + (31 * 32) + 48 + 128;
  692.      if (stmlength > 0) and ((Beginstm +stmlength) <= search.size) Then
  693.      begin
  694.        FastWrite ('Title: '+ title,2,11,113);
  695.        ID:='ScreamTracker 2.x';
  696.        if SaveIt(ID,beginstm) then writefile ('STM',beginstm,stmlength);
  697.      end;
  698.    end;
  699. End;
  700.  
  701. Procedure writeAMF; {Extracts DMP format .AMF, copies from header to end of file}
  702.                     {so the length isn't always accurate}
  703. Var amfbegin,amflength: LongInt;
  704.   title: Array [1..30] Of Char;
  705.   version:byte;
  706. Begin
  707.   AMFBegin := (l - res) + X;
  708.   amflength := 0;
  709.   h_LSeek (infile2, amfBegin + 3,0);
  710.   h_read (infile2, version, SizeOf(version));
  711.   if version<=20 then
  712.   begin
  713.   h_read (infile2, title, SizeOf (title) );
  714.   FastWrite ('Title: '+ title,2,11,113);
  715.   amflength := search.size - amfbegin;
  716.   ID:='AMF File';
  717.   if SaveIt(ID,amfbegin) then writefile ('AMF',amfbegin,amflength);
  718.   end;
  719. End;
  720.  
  721. Procedure writeDMF; {Delusion Music Format}
  722. type
  723.   dmfhead = record
  724.                 chunk: array[1..4] of char;
  725.               version: byte;
  726.               tracker: array[1..8] of char;
  727.                  song: array[1..30] of char;
  728.              composer: array[1..20] of char;
  729.                  date: array[1..3] of byte;
  730.             end;
  731.  
  732. var nextblock,dmfbegin,dmflength: LongInt;
  733.     chunk:array[1..4] of char;
  734.     i:byte;
  735.     dmfheader: dmfhead;
  736.  
  737. Begin
  738.   dmfBegin := (l - res) + X;
  739.   dmflength := 0;
  740.   h_LSeek(infile2, dmfBegin,0);
  741.   h_read(infile2, dmfheader, SizeOf(dmfheader));
  742.   i:=0;
  743.   repeat
  744.     h_read(infile2,chunk,4);
  745.     h_read(infile2,nextblock,4);
  746.     if chunk <> 'ENDE' then begin
  747.                             h_LSeek(infile2,nextblock,1);
  748.                             dmflength:=dmflength+nextblock;
  749.                             end;
  750.     inc(i);
  751.   until (chunk = 'ENDE') or (i>16);
  752.   dmflength:=dmflength+(i*8)+sizeof(dmfheader) - 4;
  753.   if (dmflength > 0) and ((dmfBegin + dmflength) <= search.size) then
  754.     begin
  755.       FastWrite ('Title: '+ dmfheader.song,2,11,113);
  756.       ID:='Delusion Music File';
  757.       if SaveIt(ID,dmfbegin) then writefile ('DMF',dmfbegin,dmflength);
  758.     end;
  759. End;
  760.  
  761. Procedure writeVOC; {Creative Voice File}
  762. var VOCbegin,VOClength: LongInt;
  763.     header: Array [1..20] Of Char;
  764.     blocklength:longint;
  765.     u,datatype:byte;
  766.  
  767. Begin
  768.   VOCBegin := (l - res) + X;
  769.   voclength := 0;
  770.   blocklength:=0;
  771.   h_LSeek (infile2, VOCBegin,0);
  772.   h_read (infile2, header, SizeOf(header));
  773.   if header='Creative Voice File'+#$1A then
  774.   begin
  775.     h_LSeek (infile2,VOCBegin+26,0);
  776.     h_read (infile2,datatype,sizeof(datatype));
  777.     h_read (infile2,blocklength,3);
  778.     VocLength:=Blocklength + 3;
  779.     u:=0;
  780.     repeat
  781.       h_LSeek(infile2,blocklength,1);
  782.       h_read(infile2,datatype,1);
  783.       blocklength:=0;
  784.       if datatype<>0 then h_read(infile2,blocklength,3);
  785.       VocLength:=VocLength + Blocklength + 3;
  786.       inc(u);
  787.     until (datatype=00) or (u > 16);
  788.     VocLength:=VocLength+26;
  789.     if (VOClength > 0) and ((VOCbegin+VOClength) <= search.size) Then
  790.     begin
  791.     ID:='Creative Voice File';
  792.     if SaveIt(ID,vocbegin) then writefile ('VOC',vocbegin,voclength);
  793.     end;
  794.   end;
  795. End;
  796.  
  797. Procedure writeMDL;
  798. Var mdlbegin,mdllength,blocklen: LongInt;
  799.                           title: array[1..32] of Char;
  800.                         blockID: array[1..2] of char;
  801.                               i: byte;
  802. begin
  803.   MDLBegin := (l - res) + X;
  804.   mdllength := 5;
  805.   h_LSeek (infile2, mdlBegin + 11,0);
  806.   h_read (infile2, title, sizeof(title));
  807.   h_LSeek (infile2, mdlBegin + 5,0);
  808.   h_read (infile2, blockID, 2);
  809.   i:=1;
  810.   repeat
  811.     h_read(infile2, blocklen, 4);
  812.     MDLlength:=MDLLength+blocklen+6;
  813.     h_LSeek(infile2, MDLbegin + MDLlength,0);
  814.     h_read(infile2, blockID,2);
  815.     inc(i);
  816.   until (blockID='SA') or (i > 16);
  817.   h_read (infile2, blocklen, 4);
  818.   MDLlength:=MDLLength+blocklen+6;
  819.   if (mdllength > 0) and ((MdlBegin +Mdllength) <= search.size) Then
  820.     begin
  821.       FastWrite ('Title: '+ title,2,11,113);
  822.       ID:='DigiTrakker MDL File';
  823.       if SaveIt(ID,mdlbegin) then writefile ('MDL',mdlbegin,mdllength);
  824.     end;
  825. end;
  826.  
  827. Procedure writeXM; {Write's FastTracker 2.0 XM (Extended Module) files}
  828.  
  829. Var XMbegin,XMlength: LongInt;
  830.     j,HeaderSize,PatternSize,InstrSize,SampHeadSize,SampleLength,TotalSample:Longint;
  831.     PackPattSize:word;
  832.     ii,i,NOP,NOI,NOS:word;
  833.     check: Array [1..17] Of Char;
  834.     title: Array [1..20] of Char;
  835.  
  836. Begin
  837.   XMBegin := (l - res) + X;
  838.   XMlength := 0;
  839.   h_LSeek(infile2, XMBegin,0);
  840.   h_read(infile2, check, sizeof(check));
  841.   if check='Extended Module: ' then
  842.     begin
  843.       h_LSeek(infile2, XMBegin+17,0);
  844.       h_read(infile2, title, sizeof(title));
  845.       h_LSeek(infile2, XMBegin+60,0);
  846.       h_read(infile2, headersize,4);
  847.       h_LSeek(infile2, XMBegin+70,0);
  848.       h_read(infile2, NOP,2);
  849.       h_LSeek(infile2, XMBegin+72,0);
  850.       h_read(infile2, NOI,2);
  851.       if (NOI<=128) and (NOP<=256) then
  852.         begin
  853.           patternsize:=0;
  854.           PackPAttSize:=0;
  855.           j:=0;
  856.           for i:= 1 to NOP do
  857.             begin
  858.               h_LSeek(infile2, XMBegin+60+headersize+j,0);
  859.               h_read(infile2, patternsize,4);
  860.               h_LSeek(infile2, XMBegin+60+headersize+j+7,0);
  861.               h_read(infile2, PackPattSize,2);
  862.               j:=j+packpattsize+patternsize;
  863.             end;
  864.           XMLength:=HeaderSize+60+j;
  865.           j:=0;
  866.           for i:= 1 to NOI do
  867.             begin
  868.               h_LSeek(infile2,XMBegin+XMLength+j,0);
  869.               h_read(infile2, Instrsize,4);
  870.               h_LSeek(infile2,XMbegin+XMLength+j+27,0);
  871.               h_read(infile2, NOS,2);
  872.               if NOS<>0 then
  873.                 begin
  874.                   h_LSeek(infile2,XMBegin+XMLength+j+29,0);
  875.                   h_read(infile2,SampHeadSize,4);
  876.                   j:=j+InstrSize;
  877.                   TotalSample:=0;
  878.                   for ii:=1 to NOS do
  879.                     begin
  880.                       h_LSeek(infile2,XMBegin+XMLength+j,0);
  881.                       h_read(infile2,SampleLength,4);
  882.                       j:=j+SampHeadSize;
  883.                       TotalSample:=TotalSample+Samplelength;
  884.                     end;
  885.                   j:=j+TotalSample;
  886.                 end
  887.               else
  888.               j:=j+InstrSize;
  889.             end;
  890.           XMLength:=XMLength+j;
  891.           if (xmlength > 0) and ((xmBegin + xmlength) <= search.size) Then
  892.             begin
  893.               FastWrite ('Title: '+ title,2,11,113);
  894.               ID:='FastTracker 2.0 File';
  895.               if SaveIt(ID,xmbegin) then writefile('XM',xmbegin,xmlength);
  896.             end;
  897.         end;
  898.     end;
  899. End;
  900.  
  901.  
  902. Procedure writeFAR; {Extracts Farandole composer files}
  903.                     {Reads from header to end of file, so search.name isn't always OK}
  904. Var i, farbegin,farlength: LongInt;
  905.   title: Array [1..40] Of Char;
  906.   headerlength,songtextlength:word;
  907.   nop:byte;
  908. Begin
  909.   farBegin := (l - res) + X;
  910.   farlength := 0;
  911.   h_LSeek (infile2, farBegin + 4,0);
  912.   h_read (infile2, title, SizeOf (title) );
  913.   FastWrite ('Title: '+ title,2,11,113);
  914.   farlength := search.size - farbegin;
  915.   ID:='Farandole File';
  916.   If SaveIt(ID,farbegin) then writefile ('FAR',farbegin,farlength);
  917. End;
  918.  
  919. Procedure writeGDM;
  920. Var i, gdmbegin,gdmlength: LongInt;
  921.   title: Array [1..32] Of Char;
  922.   headerlength,songtextlength:word;
  923.   nop:byte;
  924. Begin
  925.   GDMBegin := (l - res) + X;
  926.   h_LSeek (infile2, gdmBegin + 4,0);
  927.   h_read (infile2, title, SizeOf (title) );
  928.   FastWrite ('Title: '+ title,2,11,113);
  929.   gdmlength := search.size - gdmbegin;
  930.   ID:='GDM File';
  931.   If SaveIt(ID,gdmbegin) then writefile ('GDM',gdmbegin,gdmlength);
  932. End;
  933.  
  934. Procedure writeMXM;
  935.  
  936. Var i, mxmbegin,mxmlength: LongInt;
  937.   title: Array [1..32] Of Char;
  938.   headerlength,songtextlength:word;
  939.   nop:byte;
  940. Begin
  941.   mxmBegin := (l - res) + X;
  942.   mxmlength := search.size - mxmbegin;
  943.   ID:='MXM File';
  944.   If SaveIt(ID,mxmbegin) then writefile ('MXM',mxmbegin,mxmlength);
  945. End;
  946.  
  947. Procedure writeANM;
  948. Var i, ANMbegin,ANMlength: LongInt;
  949.     nop:byte;
  950. Begin
  951.   ANMbegin := (l - res) + X;
  952.   ANMlength := search.size - ANMbegin;
  953.   ID:='GDM File';
  954.   If SaveIt(ID,ANMbegin) then writefile ('ANM',ANMbegin,ANMlength);
  955. End;
  956.  
  957. Procedure writeULT; {Extracts UltraTracker format, copies from header to end of file}
  958.                     {so the length isn't always accurate}
  959. Var i, ultbegin,ultlength: LongInt;
  960.   title: Array [1..32] Of Char;
  961.   header: array[1..15] of char;
  962. Begin
  963.   ULTBegin := (l - res) + X;
  964.   ultlength := 0;
  965.   h_read(infile2, header, sizeof(header));
  966.   if header='MAS_UTrack_V001' then
  967.   begin
  968.     h_read (infile2, title, SizeOf (title) );
  969.     FastWrite ('Title: '+ title,2,11,113);
  970.     ID:='UltraTracker File';
  971.     ultlength := search.size - ultbegin;
  972.     if SaveIt(ID,ultbegin) then writefile ('ULT',ultbegin,ultlength);
  973.   end;
  974. End;
  975.  
  976. Procedure writePTM; {Extracts PolyTracker format, copies from header to end of file}
  977.                     {so the length isn't always accurate...mostly NOT}
  978. Var titlePTM: Array [1..28] Of Char;
  979.   noo, nos, nop: Word;
  980.   sample, slength: LongInt;
  981.   i,beginPTM, lengthPTM, memsegold, Length: LongInt;
  982.   t: Byte;
  983.  
  984. Begin
  985.   lengthPTM := 0;
  986.   memsegold := 0;
  987.   BeginPTM := (l - res) + X - 44;
  988.   h_LSeek (infile2, BeginPTM,0);
  989.   h_read (infile2, titlePTM, SizeOf (titlePTM) ); {Read title}
  990.   h_LSeek (infile2, BeginPTM + 32 + 2,0);
  991.   h_read (infile2, nos, SizeOf(nos));
  992.   h_LSeek (infile2, BeginPTM + 608 + 18,0);
  993.   if nos <> 0 then
  994.   begin
  995.       h_LSeek (infile2, beginPTM+608 + 18 + ((nos-1)*80),0);
  996.       h_read (infile2, sample, SizeOf(sample));
  997.       h_read (infile2, slength, SizeOf(slength));
  998.       lengthPTM:=slength+sample;
  999.   end;
  1000.   if (lengthPTM > 0) and ((BeginPTM +lengthPTM) <= search.size) Then
  1001.   begin
  1002.     ID:='PolyTracker File';
  1003.     FastWrite ('Title: '+ titlePTM,2,11,113);
  1004.     if SaveIt(ID,beginPTM) then writefile ('PTM',beginPTM,LengthPTM);
  1005.   end;
  1006. End;
  1007.  
  1008. Procedure writePAC; {Extracts SB Studio PAC file}
  1009. Var i, pacbegin,paclength: LongInt;
  1010.  
  1011. Begin
  1012.   PACBegin := (l - res) + X;
  1013.   paclength := 0;
  1014.   h_LSeek (infile2, pacBegin + 4,0);
  1015.   h_read(infile2, paclength,4);
  1016.   paclength:=paclength+8;
  1017.   if (paclength > 0) and ((pacBegin + paclength) <= search.size) Then
  1018.     begin
  1019.       ID:='SB Studio .PAC File';
  1020.       if SaveIt(ID,pacbegin) then writefile ('PAC',pacbegin,paclength);
  1021.     end;
  1022. End;
  1023.  
  1024. Procedure writeFNK;
  1025. Var i, fnkbegin,fnklength: LongInt;
  1026.  
  1027. Begin
  1028.   fnkBegin := (l - res) + X;
  1029.   fnklength := 0;
  1030.   h_LSeek (infile2, fnkBegin + 8,0);
  1031.   h_read(infile2, fnklength,4);
  1032.   if (fnklength > 0) and ((fnkBegin + fnklength) <= search.size) Then
  1033.     begin
  1034.       ID:='FunkTracker File';
  1035.       if SaveIt(ID,fnkbegin) then writefile ('FNK',fnkbegin,fnklength);
  1036.     end;
  1037. End;
  1038.  
  1039. Procedure writePSM;
  1040. Var i, psmbegin,psmlength: LongInt;
  1041.  
  1042. Begin
  1043.   PSMBegin := (l - res) + X;
  1044.   psmlength := 0;
  1045.   h_LSeek (infile2, psmbegin + 4,0);
  1046.   h_read(infile2, psmlength,4);
  1047.   psmlength:=psmlength+12;
  1048.   if (psmlength > 0) and ((psmBegin + psmlength) <= search.size) Then
  1049.     begin
  1050.       ID:='PSM File';
  1051.       if SaveIt(ID,psmbegin) then writefile('PSM',psmbegin,psmlength);
  1052.     end;
  1053. End;
  1054.  
  1055. Procedure writeRIX;
  1056.  
  1057. Var i, Rixbegin,Rixlength: LongInt;
  1058.     rixhdr: record
  1059.               rix3:array[1..4] of char;  {Should be RIX3}
  1060.               xres, yres:integer;
  1061.               mode      :integer;
  1062.             end;
  1063. Begin
  1064.   rixBegin := (l - res) + X;
  1065.   rixlength := 0;
  1066.   h_LSeek(infile2, rixBegin,0);
  1067.   h_read(infile2, rixhdr, sizeof(rixhdr));
  1068.   rixlength:=longint(rixhdr.xres)*longint(rixhdr.yres)+778;
  1069.   if (rixlength > 0) and ((rixBegin + rixlength) <= search.size) Then
  1070.     begin
  1071.       ID:='ColoRIX Image';
  1072.       FastWrite ('Resolution: '+ToStr(rixhdr.xres,0)+' x '+ToStr(rixhdr.yres,0),2,11,113);
  1073.       if SaveIt(ID,rixbegin) then writefile ('SCX',rixbegin,rixlength);
  1074.     end;
  1075. End;
  1076.  
  1077. Procedure writeDLZ;
  1078. Var i, DLZbegin,DLZlength: LongInt;
  1079.     t1:byte;
  1080.     t2:word;
  1081. Begin
  1082.   DLZBegin := (l - res) + X - 6;
  1083.   DLZlength := 0;
  1084.   h_LSeek(infile2, DLZBegin + 9,0);
  1085.   h_read(infile2, t1,1);
  1086.   h_read(infile2, t2,2);
  1087.   DLZlength:=longint(t1)*$10000 + longint(t2) + 17;
  1088.   if (DLZlength > 0) and ((DLZBegin + DLZlength) <= search.size) Then
  1089.     begin
  1090.       ID:='Diet compressed datafile';
  1091.       if SaveIt(ID,DLZbegin) then writefile ('DLZ',DLZbegin,DLZlength);
  1092.     end;
  1093. End;
  1094.  
  1095. Procedure WriteUNI;
  1096. var  uniLength, uniBegin:longint;
  1097.      version:char;
  1098. Begin
  1099.   uniBegin := (l - res) + X;
  1100.   unilength := 0;
  1101.   unilength := search.size - unibegin;
  1102.   h_LSeek(infile2,unibegin+3,0);
  1103.   h_read(infile2,version, 1);
  1104.   if (version >= '0') and (version <= '9') then
  1105.     begin
  1106.       ID:='UniMOD File';
  1107.       If SaveIt(ID,unibegin) then writefile ('UNI',unibegin,unilength);
  1108.     end;
  1109. End;
  1110.  
  1111. Procedure WriteAMS;
  1112. var  amsLength, amsBegin:longint;
  1113.      header:array[1..8] of char;
  1114.  
  1115. Begin
  1116.   amsBegin := (l - res) + X;
  1117.   amslength := 0;
  1118.   amslength := search.size - amsbegin;
  1119.   h_LSeek(infile2,amsBegin,0);
  1120.   h_read(infile2,header,sizeof(header));
  1121.   if header='Extreme0' then
  1122.     begin
  1123.       ID:='Extreme Tracker Module';
  1124.       If SaveIt(ID,amsbegin) then writefile ('AMS',amsbegin,amslength);
  1125.     end;
  1126. End;
  1127.  
  1128. Procedure writeHMI;
  1129. Var i, hmibegin,hmilength: LongInt;
  1130.     header: array[1..8] of char;
  1131. Begin
  1132.   hmiBegin := (l - res) + X;
  1133.   hmilength := 0;
  1134.   h_LSeek(infile2, hmiBegin,0);
  1135.   h_read(infile2, header,sizeof(header));
  1136.   if header='HMIMIDIP' then
  1137.   begin
  1138.     h_LSeek(infile2, hmiBegin + $20,0);
  1139.     h_read(infile2, hmilength,4);
  1140.     if (hmilength > 0) and ((hmiBegin + hmilength) <= search.size) Then
  1141.       begin
  1142.         ID:='HMP MIDI file';
  1143.         if SaveIt(ID,hmibegin) then writefile ('HMP',hmibegin,hmilength);
  1144.       end;
  1145.   end;
  1146. End;
  1147.  
  1148. procedure writeMIDI; {Extract MIDI type 0 and 1 files}
  1149. var i,hoog,laag,noft:byte;
  1150.     midibegin,tracklength,midilength:longint;
  1151. begin
  1152.   midiBegin := (l - res) + X;
  1153.   midilength := 0;
  1154.   tracklength:=0;
  1155.   h_LSeek(infile2,midibegin+10,0);
  1156.   h_read(infile2,hoog,sizeof(hoog));
  1157.   h_read(infile2,laag,sizeof(laag));
  1158.   noft:=(hoog*256)+laag;  {Number of tracks}
  1159.   h_LSeek(infile2,midibegin+14,0);
  1160.   for i:=1 to noft do
  1161.     begin
  1162.       h_LSeek(infile2,h_filepos(infile2)+4+tracklength,0);
  1163.       h_Read(infile2,tracklength,sizeof(tracklength));
  1164.       tracklength:=IntelLong(tracklength);
  1165.       midilength:=midilength+tracklength;
  1166.     end;
  1167.   midilength:=midilength+14+(noft*8);
  1168.   if (midilength > 0) and ((midiBegin+midilength) <= search.size) Then
  1169.   begin
  1170.     ID:='MIDI File';
  1171.     if SaveIt(ID,midibegin) then writefile('MID',midibegin,midilength);
  1172.   end;
  1173. end;
  1174.  
  1175. Procedure writeMUS; {Extracts .MUS files}
  1176. Var MUSbegin,MUSlength: longint;
  1177.     start, length: word;
  1178.  
  1179. Begin
  1180.   MusBegin := (l - res) + X;
  1181.   MUSlength := 0;
  1182.   h_LSeek (infile2, MUSBegin + 4,0);
  1183.   h_read (infile2, Length, 2);
  1184.   h_read (infile2, Start, 2);
  1185.   MUSLength:=Longint(Start+Length);
  1186.   if (MUSlength > 0) and ((MUSBegin+MUSlength) <= search.size) Then
  1187.     begin
  1188.       ID:='MUS MIDI file';
  1189.       If SaveIt(ID,MUSbegin) then writefile ('MUS',MUSbegin,MUSlength);
  1190.     end;
  1191. End;
  1192.  
  1193.  
  1194. Procedure writeIFF; {Extracts LBM, XMI, IFF, AIF files}
  1195. Var i, IFFbegin,IFFlength: LongInt;
  1196.     header:array[1..4] of char;
  1197.     ext: array[1..3] of char;
  1198.     t: Byte;
  1199.     resolution:record
  1200.                  width,height:word;
  1201.                end;
  1202.  
  1203. Begin
  1204.   ext:='   ';
  1205.   IFFBegin := (l - res) + X;
  1206.   IFFlength := 0;
  1207.   h_LSeek (infile2, IFFBegin + 4,0);
  1208.   h_Read(infile2,IFFLength,sizeof(IFFLength));
  1209.   IFFLength:=IntelLong(IFFLength);
  1210.   h_LSeek(infile2, IFFBegin + 8,0);
  1211.   h_read(infile2, header,sizeof(header));
  1212.   h_LSeek(infile2, IFFBegin + 20,0);
  1213.   h_read(infile2, resolution,sizeof(resolution));
  1214.   resolution.width:=swap(resolution.width);
  1215.   resolution.height:=swap(resolution.height);
  1216.   IFFlength:=IFFlength+8;
  1217.   if (IFFlength > 0) and ((IFFBegin +IFFlength) <= search.size) Then
  1218.   begin
  1219.     if (header = 'ILBM') or (header = 'PBM ') then
  1220.                        begin
  1221.                          ID:='LBM Picture';
  1222.                          ext:='LBM';
  1223.                          FastWrite ('Resolution: '+ToStr(resolution.width,0)+' x '+ToStr(resolution.height,0),2,11,113);
  1224.                          if SaveIt(ID,IFFbegin) then writefile (ext,IFFbegin,IFFlength);
  1225.                        end
  1226.     else
  1227.     if (header = 'ANBM') or (header='ANIM') then
  1228.                        begin
  1229.                          ID:='De Luxe Paint Animation';
  1230.                          ext:='ANM';
  1231.                          if SaveIt(ID,IFFbegin) then writefile (ext,IFFbegin,IFFlength);
  1232.                        end
  1233.     else
  1234.     if header = 'XMID' then
  1235.                        begin
  1236.                          ID:='XMI MIDI file';
  1237.                          ext:='XMI';
  1238.                          if SaveIt(ID,IFFbegin) then writefile (ext,IFFbegin,IFFlength);
  1239.                        end
  1240.     else
  1241.     if header = '8SVX' then
  1242.                        begin
  1243.                          ID:='8-bit SVX sound file';
  1244.                          ext:='8SX';
  1245.                          if SaveIt(ID,IFFbegin) then writefile (ext,IFFbegin,IFFlength);
  1246.                        end
  1247.     else
  1248.     if header = 'AIFF' then
  1249.                        begin
  1250.                          ID:='AIFF sound file';
  1251.                          ext:='AIF';
  1252.                          if SaveIt(ID,IFFbegin) then writefile (ext,IFFbegin,IFFlength);
  1253.                        end
  1254.     else begin
  1255.            ID:='Unknown IFF file ('+header+')';
  1256.            ext:='IFF';
  1257.            If SaveIt(ID,IFFBegin) then writefile(ext,IFFBegin,IFFLength);
  1258.          end;
  1259.   end;
  1260. End;
  1261.  
  1262. Procedure writeAU; {Extracts AU files}
  1263. Var AUbegin,AUlength, start, length: LongInt;
  1264.  
  1265. Begin
  1266.   AUBegin := (l - res) + X;
  1267.   AUlength := 0;
  1268.   h_LSeek(infile2, AUBegin + 4,0);
  1269.   h_read(infile2,start,sizeof(start));
  1270.   h_read(infile2,length,sizeof(length));
  1271.   AULength:=IntelLong(Start)+IntelLong(Length);
  1272.   if (AUlength > 0) and ((AUBegin+AUlength) <= search.size) Then
  1273.     begin
  1274.       ID:='AU sound file';
  1275.       If SaveIt(ID,AUbegin) then writefile ('AU',AUbegin,AUlength);
  1276.     end;
  1277. End;
  1278.  
  1279. Procedure writeBMP;
  1280. Var bmpbegin,BMPlength: LongInt;
  1281.     resolution:record
  1282.                  width,height:longint;
  1283.                end;
  1284.  
  1285. Begin
  1286.   bmpBegin := (l - res) + X;
  1287.   bmplength := 0;
  1288.   h_LSeek (infile2, bmpBegin + 2,0);
  1289.   if (search.size-bmpbegin) > 4 then h_read (infile2, bmplength, SizeOf (bmplength) ); {Reads length of BMP}
  1290.   h_LSeek(infile2, bmpBegin + $12,0);
  1291.   h_read(infile2, resolution,sizeof(resolution));
  1292.   if (abs(resolution.width) < 5000) and (abs(resolution.height) < 5000) then
  1293.   if (bmplength > 0) and ((bmpBegin +bmplength) <= search.size) Then
  1294.     begin
  1295.       ID:='BMP Picture';
  1296.       FastWrite ('Resolution: '+ToStr(resolution.width,0)+' x '+ToStr(resolution.height,0),2,11,113);
  1297.       If SaveIt(ID,bmpbegin) then writefile ('BMP',bmpbegin,BMPlength);
  1298.     end;
  1299. End;
  1300.  
  1301. Procedure writeFLIorC;
  1302. Var flibegin,flilength: LongInt;
  1303.  
  1304. Begin
  1305.   fliBegin := (l - res) + X - 4;
  1306.   flilength := 0;
  1307.   h_LSeek (infile2, fliBegin,0);
  1308.   h_read(infile2,flilength,4);
  1309.   if (flilength > 0) and ((fliBegin + flilength) <= search.size) Then
  1310.     begin
  1311.       ID:='AutoDesk Animation';
  1312.       If SaveIt(ID,flibegin) then writefile ('FLI',flibegin,flilength);
  1313.     end;
  1314. End;
  1315.  
  1316. Procedure writeMOV;
  1317. Var movbegin,t,movlength: LongInt;
  1318.     header:array[1..4] of char;
  1319. Begin
  1320.   movBegin := (l - res) + X - 4;
  1321.   movlength := 0;
  1322.   h_LSeek(infile2,movBegin,0);
  1323.   h_read(infile2,t,4);
  1324.   movlength:=IntelLong(t);
  1325.   h_LSeek(infile2,movlength,0);
  1326.   h_read(infile2,t,4);
  1327.   movlength:=movlength+IntelLong(t);
  1328.   h_read(infile2,header,4);
  1329.   if header='moov' then
  1330.   if (movlength > 0) and ((movBegin + movlength) <= search.size) Then
  1331.     begin
  1332.       ID:='QuickTime Movie file';
  1333.       If SaveIt(ID,movbegin) then writefile ('MOV',movbegin,movlength);
  1334.     end;
  1335. End;
  1336.  
  1337. Procedure FoundRIFF;
  1338. var RiffLength,RiffBegin:longint;
  1339.     header:array[1..4] of char;
  1340.     ext:array[1..3] of char;
  1341.  
  1342.  
  1343. Begin
  1344.   RIFFbegin:= (l - res) + X;
  1345.   h_LSeek (infile2, RIFFbegin+8,0);
  1346.   h_read(infile2,header,sizeof(header));
  1347.   h_LSeek(infile2,RIFFbegin+4,0);
  1348.   h_read(infile2,RIFFLength,4);
  1349.   RIFFLength:=RIFFLength+8;
  1350.   if (RIFFlength > 0) and ((RIFFBegin + RIFFlength) <= search.size) Then
  1351.   if abs(RIFFLength)+abs(RIFFbegin) <= search.size then
  1352.   begin
  1353.     if header='WAVE' then begin
  1354.                             ID:='Windows Wave file';
  1355.                             ext:='WAV';
  1356.                             If SaveIt(ID,RIFFBegin) then writefile(ext,RIFFBegin,RIFFLength);
  1357.                           end
  1358.     else
  1359.     if header='sfbk' then begin
  1360.                             ID:='Emu SoundFont file (AWE32)';
  1361.                             ext:='SBK';
  1362.                             If SaveIt(ID,RIFFBegin) then writefile(ext,RIFFBegin,RIFFLength);
  1363.                           end
  1364.     else
  1365.     if header='AVI ' then begin
  1366.                             ID:='Windows AVI file';
  1367.                             ext:='AVI';
  1368.                             If SaveIt(ID,RIFFBegin) then writefile(ext,RIFFBegin,RIFFLength);
  1369.                           end
  1370.     else
  1371.     if header='DSMF' then begin
  1372.                             ID:='Digital Sound Module';
  1373.                             ext:='DSM';
  1374.                             If SaveIt(ID,RIFFBegin) then writefile(ext,RIFFBegin,RIFFLength);
  1375.                           end
  1376.     else begin
  1377.            ID:='Unknown RIFF file ('+header+')';
  1378.            ext:='RFF';
  1379.            If SaveIt(ID,RIFFBegin) then writefile(ext,RIFFBegin,RIFFLength);
  1380.          end;
  1381.   end;
  1382. end;
  1383.  
  1384. Procedure WriteGIF; {Only detection of GIF}
  1385. var header:record
  1386.            hdr:array[1..6] of char;
  1387.            width:word;
  1388.            height:word;
  1389.            colors:byte;
  1390.            end;
  1391.   gifbegin,giflength:longint;
  1392.  
  1393. Begin
  1394.   GIFBegin := (l - res) + X ;
  1395.   GIFlength := 0;
  1396.   h_LSeek (infile2, GIFBegin,0);
  1397.   h_read (infile2, header, SizeOf (header) );
  1398.   if (header.hdr='GIF87a') or (header.hdr='GIF89a') then
  1399.   begin
  1400.     GIFlength := 768+longint(header.width)*longint(header.height);
  1401.     ID:='GIF Picture';
  1402.     FastWrite ('Resolution: '+ToStr(header.width,0)+' x '+ToStr(header.height,0),2,11,113);
  1403.     If SaveIt(ID,GIFbegin) then writefile ('GIF',GIFbegin,GIFlength);
  1404.   end;
  1405. End;
  1406.  
  1407. Procedure WriteCMF;
  1408. var  cmfLength, cmfBegin:longint;
  1409.  
  1410. Begin
  1411.   cmfBegin := (l - res) + X;
  1412.   cmflength := search.size - cmfbegin;
  1413.   ID:='CMF File';
  1414.   If SaveIt(ID,cmfbegin) then writefile ('CMF',cmfbegin,cmflength);
  1415. End;
  1416.  
  1417. Procedure WriteD00;
  1418. var  cnt, d00Length, d00Begin:longint;
  1419.      title:array[1..32] of char;
  1420.      hdr:array[1..6] of char;
  1421.      ptr_table:array[1..5] of word;
  1422.      i:byte;
  1423.      ptr:word;
  1424. Begin
  1425.   d00Begin := (l - res) + X;
  1426.   d00length := search.size - d00begin;
  1427.   h_Lseek(infile2,d00Begin,0);
  1428.   h_read(infile2,hdr,sizeof(hdr));
  1429.   if hdr='JCH'+#$26+#$02+#$66 then
  1430.   begin
  1431.     h_Lseek(infile2,d00Begin+$b,0);
  1432.     h_read(infile2,title,sizeof(title));
  1433.     h_Lseek(infile2,d00Begin+$6b,0);
  1434.     h_read(infile2,ptr_table,sizeof(ptr_table));
  1435.     ptr:=0;
  1436.     cnt:=0;
  1437.     For i := 1 To 5 Do If ptr < ptr_table[i] Then ptr:=ptr_table[i];
  1438.     h_lseek(infile2,d00begin+ptr,0);
  1439.     d00length:=longint(ptr);
  1440.     repeat
  1441.       h_read(infile2,ptr,sizeof(ptr));
  1442.       inc(cnt,2);
  1443.     until (ptr=$FFFF) or (cnt>4000);
  1444.     inc(d00length,cnt);
  1445.     ID:='Vibrants D00 File';
  1446.     if (d00length > 0) and ((d00Begin + d00length) <= search.size) Then
  1447.     begin
  1448.       FastWrite('Title: '+ title,2,11,113);
  1449.       If SaveIt(ID,d00begin) then writefile ('D00',D00begin,d00length);
  1450.     end;
  1451.   end;
  1452. End;
  1453.  
  1454. Procedure WriteRAD;
  1455. var  radLength, radBegin:longint;
  1456.      rad_note:record
  1457.                 channel,note,effect:byte;
  1458.               end;
  1459.      param,line,version:byte;
  1460.      radchk:array[1..16] of char;
  1461.      pat_table:array[1..32] of word;
  1462.      i,pat_off:word;
  1463. Begin
  1464.   radBegin := (l - res) + X;
  1465.   h_Lseek(infile2,RadBegin,0);
  1466.   h_read(infile2,radchk,sizeof(radchk));
  1467.   h_read(infile2,version,sizeof(version));
  1468.   if (radchk = 'RAD by REALiTY!!') and (version=$10) then
  1469.                  begin
  1470.                    h_read(infile2,version,sizeof(version));
  1471.                    if (version and $80) = $80 then
  1472.                    while version<>0 do h_read(infile2,version,sizeof(version));
  1473.                    h_read(infile2,version,sizeof(version));
  1474.                    while version<>0 do begin
  1475.                                           h_lseek(infile2,11,1);
  1476.                                           h_read(infile2,version,sizeof(version));
  1477.                                        end;
  1478.                    h_read(infile2,version,sizeof(version));
  1479.                    h_lseek(infile2,version,1);
  1480.                    h_read(infile2,pat_table,sizeof(pat_table));
  1481.                    pat_off:=0;
  1482.                    For i := 1 To 32 Do If pat_off < pat_table[i] Then pat_off:=pat_table[i];
  1483.                    h_lseek(infile2,radbegin+pat_off,0);
  1484.                    radlength:=pat_off;
  1485.                    repeat
  1486.                      h_read(infile2,line,sizeof(line));
  1487.                      inc(radlength);
  1488.                      repeat
  1489.                        h_read(infile2,rad_note,sizeof(rad_note));
  1490.                        if TestBit(rad_note.effect,$F) then
  1491.                        begin
  1492.                          h_read(infile2,param,sizeof(param));
  1493.                          inc(radlength);
  1494.                        end;
  1495.                        radlength:=radlength+3;
  1496.                      until (rad_note.channel and $80)=$80;
  1497.                    until (line and $80)=$80;
  1498.                    ID:='Reality Adlib Tracker File';
  1499.                    If SaveIt(ID,radbegin) then writefile ('RAD',radbegin,radlength);
  1500.               end;
  1501. End;
  1502.  
  1503. Procedure WriteSadt;
  1504. var  sadtLength, sadtBegin:longint;
  1505.      k,i,nop,notr:word;
  1506.      version:byte;
  1507.      ext:array[1..3] of char;
  1508.      trackorder:array[1..64,1..9] of byte;
  1509. Begin
  1510.   sadtBegin := (l - res) + X;
  1511.   h_Lseek(infile2,sadtBegin+4,0);
  1512.   h_read(infile2,version,sizeof(version));
  1513.   ID:='SAdT File';
  1514.   if version < 7 then begin
  1515.                         h_Lseek(infile2,sadtBegin+1097,0);
  1516.                         h_read(infile2,nop,sizeof(nop));
  1517.                         sadtlength := 1103 + longint(nop) * 2880;
  1518.                         ext:='SAT';
  1519.                       end;
  1520.   if (version >= 7) and (version <= 9) then
  1521.                       begin
  1522.                         h_Lseek(infile2,sadtBegin+1094,0);
  1523.                         h_read(infile2,nop,sizeof(nop));
  1524.                         h_Lseek(infile2,sadtBegin+1612,0);
  1525.                         h_read(infile2,trackorder,sizeof(trackorder));
  1526.                         notr:=0;
  1527.                         for k:=1 to nop do
  1528.                           for i := 1 To 9 Do if notr < trackorder[k,i] Then notr:=trackorder[k,i];
  1529.                         sadtlength := 2190 + longint(notr) * 192;
  1530.                         ext:='SA2';
  1531.                         end;
  1532.   if (sadtlength > 0) and ((sadtBegin + sadtlength) <= search.size) Then
  1533.   If SaveIt(ID,sadtbegin) then writefile ('SAT',sadtbegin,sadtlength);
  1534. End;
  1535.  
  1536. Procedure WriteJPG;
  1537.  
  1538. var  jpgLength, jpgBegin:longint;
  1539.      i:byte;
  1540.      JPG_ID:array[1..2] of char;
  1541.      header:record
  1542.                seg_id:byte;
  1543.                seg_type:byte;
  1544.                seg_sh:byte;
  1545.                seg_sl:byte;
  1546.              end;
  1547.     resolution:record
  1548.                  height,width:word;
  1549.                end;
  1550.  
  1551. Begin
  1552.   jpgBegin := (l - res) + X - 6 ;
  1553.   jpglength := 0;
  1554.   h_LSeek(infile2,JPGBegin,0);
  1555.   h_read(infile2,JPG_ID,2);
  1556.   if JPG_ID=#$FF+#$D8 then
  1557.   begin
  1558.   header.seg_sl:=0;
  1559.   header.seg_sh:=0;
  1560.   i:=0;
  1561.   repeat
  1562.     jpglength:=jpglength+longint((256*header.seg_sh)+header.seg_sl)+2;
  1563.     h_LSeek(infile2,jpglength,0);
  1564.     h_read(infile2,header,sizeof(header));
  1565.     inc(i);
  1566.   until (header.seg_id=$ff) and (header.seg_type>=$c0) and (header.seg_type<=$c1) or (i > 50);
  1567.   h_LSeek(infile2,jpglength+5,0);
  1568.   h_read(infile2,resolution,sizeof(resolution));
  1569.   resolution.width:=swap(resolution.width);
  1570.   resolution.height:=swap(resolution.height);
  1571.   jpglength := 768+longint(resolution.height)*longint(resolution.width)*2;
  1572.   FastWrite ('Resolution: '+ToStr(resolution.width,0)+' x '+ToStr(resolution.height,0),2,11,113);
  1573.   ID:='JPG Picture';
  1574.   If SaveIt(ID,jpgbegin) then writefile ('JPG',jpgbegin,jpglength);
  1575.   end;
  1576. End;
  1577.  
  1578. Procedure FoundPCX; {Only detection of JPG}
  1579. var Nplanes,i,Cnt,i3:byte;
  1580.     i2,error,TotalBytes,Ymax,Ymin,BytesPerLine:word;
  1581.     l2,l3,pcxBegin,pcxLength:longint;
  1582.  
  1583. Begin
  1584.   pcxLength:=0;
  1585.   PCXBegin := (l - res) + X;
  1586.   FastWrite('Scanning for PCX...',2,14,121);
  1587.   h_LSeek(infile2, pcxBegin+4,0);
  1588.   h_read(infile2, l3, sizeof(l3));
  1589.   if l3=0 then
  1590.     begin
  1591.       h_LSeek(infile2, pcxBegin+$A,0);
  1592.       h_read(infile2, Ymax, sizeof(Ymax));
  1593.       h_LSeek(infile2, pcxBegin+$41,0);
  1594.       h_read(infile2, Nplanes, sizeof(Nplanes));
  1595.       h_read(infile2, BytesPerLine, sizeof(BytesPerLine));
  1596.       TotalBytes:=Nplanes*BytesPerLine;
  1597.       h_LSeek(infile2, pcxBegin+128,0);
  1598.       l3:=0;
  1599.       for i2:=0 to Ymax do
  1600.       begin
  1601.         l2:=0;
  1602.         repeat
  1603.           cnt:=1;
  1604.           error:=h_read(infile2, i,sizeof(i));
  1605.           if (i and $C0) = $C0 then begin  {11000000}
  1606.                                       cnt:= ($3F and i); {00111111}
  1607.                                       error:=h_read(infile2, i, sizeof(i));
  1608.                                       inc(l3);
  1609.                                     end;
  1610.           inc(l2,cnt);
  1611.           inc(l3);
  1612.        until (l2=TotalBytes) or (error<>1);
  1613.      end;
  1614.      error:=h_read(infile2, i,sizeof(i));
  1615.      if (error=1) and (i=12) then pcxlength:=l3+769+128
  1616.                              else pcxlength:=l3+128;
  1617.      if (pcxlength > 0) and ((pcxBegin + pcxlength) <= search.size) Then
  1618.      begin
  1619.         ID:='PCX File';
  1620.         FastWrite ('Resolution: '+ToStr(BytesPerLine,0)+' x '+ToStr(Ymax+1,0),2,11,113);
  1621.         If SaveIt(ID,pcxbegin) then writefile ('PCX',pcxbegin,pcxlength);
  1622.      end;
  1623.   end;
  1624.   ClearLine;
  1625.  
  1626. End;
  1627.  
  1628. Procedure writeCustom(custom:string); {Detected the Custom Header}
  1629. var position,CustomBegin,CustomLength,offset:longint;
  1630.     number:string;
  1631.     i:byte;
  1632. Begin
  1633.   Position := (l - res) + X;
  1634.   number:=option[3];
  1635.   offset:=0;
  1636.   if number[1]='$' then begin {It's an HEX value...}
  1637.                            for i:=2 to (length(number)) do
  1638.                            case number[i] of {This formula converts a HEX string to a longint}
  1639.                            '0'..'9':offset:=offset+(ORD(number[i])-$30)*trunc(exp((length(number)-i)*ln(16)));
  1640.                            'A'..'F':offset:=offset+(ORD(number[i])-$37)*trunc(exp((length(number)-i)*ln(16)));
  1641.                            end;
  1642.                          end
  1643.                     else begin {It's decimal...}
  1644.                             for i:=1 to (length(number)) do {And this converts a DECIMAL string to a longint}
  1645.                             offset:=offset+(ORD(number[i])-$30)*trunc(exp((length(number)-i)*ln(10)));
  1646.                          end;
  1647.   CustomBegin:= position-offset+1;
  1648.   Customlength := search.size - CustomBegin;
  1649.   custom[1]:='(';
  1650.   ID:='Custom '+custom+') File';
  1651.   if SaveIt(ID,position) then writefile ('TMP',custombegin,customlength);
  1652. End;
  1653.  
  1654. Procedure PartialCopy; {Copies a part from x to y out of a file}
  1655. var number1,number2:string;
  1656.     copybegin,copyend:longint;
  1657.     i:byte;
  1658. Begin
  1659.   number1:=option[2]; {begin}
  1660.   number2:=option[3]; {end}
  1661.   copybegin:=0;
  1662.   copyend:=0;
  1663.   upper(number1);
  1664.   upper(number2);
  1665.   if number1[2]='$' then begin {It's an HEX value...}
  1666.                            for i:=3 to (length(number1)) do
  1667.                            case number1[i] of {This formula converts a HEX string to a longint}
  1668.                            '0'..'9':copybegin:=copybegin+(ORD(number1[i])-$30)*trunc(exp((length(number1)-i)*ln(16)));
  1669.                            'A'..'F':copybegin:=copybegin+(ORD(number1[i])-$37)*trunc(exp((length(number1)-i)*ln(16)));
  1670.                            end;
  1671.                          end
  1672.                     else begin {It's decimal...}
  1673.                             for i:=2 to (length(number1)) do {And this converts a DECIMAL string to a longint}
  1674.                             copybegin:=copybegin+(ORD(number1[i])-$30)*trunc(exp((length(number1)-i)*ln(10)));
  1675.                          end;
  1676.   case number2[1] of
  1677.   '$': {It's an HEX value...}
  1678.        for i:=2 to (length(number2)) do
  1679.          case number2[i] of
  1680.          '0'..'9':copyend:=copyend+(ORD(number2[i])-$30)*trunc(exp((length(number2)-i)*ln(16)));
  1681.          'A'..'F':copyend:=copyend+(ORD(number2[i])-$37)*trunc(exp((length(number2)-i)*ln(16)));
  1682.          end;
  1683.   'E': if (number2[2]='N') and (number2[3]='D') then copyend:=search.size;
  1684.   else {It's decimal...}
  1685.        for i:=1 to (length(number2)) do
  1686.           copyend:=copyend+(ORD(number2[i])-$30)*trunc(exp((length(number2)-i)*ln(10)));
  1687.   end;
  1688.   if (copybegin<search.size) and (copybegin <= copyend) then writefile('$$$',copybegin,(copyend-copybegin));
  1689. end;
  1690.  
  1691. procedure SearchExtended;assembler;
  1692.  
  1693. asm
  1694.         mov cx,res
  1695.         mov di,-1
  1696. @search:cmp cx,0
  1697.         jz @nothing
  1698.         dec cx
  1699.         inc di
  1700.         mov ah,byte ptr sample[di]
  1701.         mov al,byte ptr sample[di+1]
  1702.         cmp ax,11AFh
  1703.         jb @search
  1704.         cmp ax,'if'
  1705.         ja @search
  1706. @FLI:   cmp ax,11AFh
  1707.         ja @FLC
  1708.         jb @search
  1709.         mov x,di
  1710.         push di
  1711.         push cx
  1712.         call WriteFLIorC
  1713.         pop cx
  1714.         pop di
  1715.         jmp @search
  1716. @FLC:   cmp ax,12AFh
  1717.         ja @E669
  1718.         jb @search
  1719.         mov x,di
  1720.         push di
  1721.         push cx
  1722.         call WriteFLIorC
  1723.         pop cx
  1724.         pop di
  1725.         jmp @search
  1726. @E669:  cmp ax,'JN'
  1727.         ja @669
  1728.         jb @search
  1729.         mov x,di
  1730.         push di
  1731.         push cx
  1732.         call Write669
  1733.         pop cx
  1734.         pop di
  1735.         jmp @search
  1736. @669:   cmp ax,'if'
  1737.         jnz @search
  1738.         mov x,di
  1739.         push di
  1740.         push cx
  1741.         call Write669
  1742.         pop cx
  1743.         pop di
  1744.         jmp @search
  1745. @nothing:
  1746. end;
  1747.  
  1748. procedure SearchCustom;
  1749. var custom:string;
  1750.  
  1751. begin
  1752.   custom:=option[2];
  1753.   for X:=0 to res do
  1754.      begin
  1755.        found:=0;
  1756.        for y:=1 to (ord(custom[0])-1) do
  1757.                                       if sample[X+Y]=custom[Y+1] then inc(found);
  1758.        if found=ord(custom[0])-1 then writeCustom(custom);
  1759.      end;
  1760. end;
  1761.  
  1762. procedure SearchEngine;assembler;
  1763. asm
  1764.         mov cx,res
  1765.         mov di,-1
  1766. @search:cmp cx,0
  1767.         jz @nothing
  1768.         dec cx
  1769.         inc di
  1770.         mov ah,byte ptr sample[di]
  1771.         mov al,byte ptr sample[di+1]
  1772.         mov bh,byte ptr sample[di+2]
  1773.         mov bl,byte ptr sample[di+3]
  1774.         cmp ax,$0A05
  1775.         jb @search
  1776.         cmp ax,'md'
  1777.         ja @search
  1778.  
  1779.         cmp ax,$0A05
  1780.         ja @AU
  1781.         cmp bl,$08  { $0108 -> packed ; $0008 -> unpacked}
  1782.         jnz @search
  1783.         mov x,di
  1784.         push di
  1785.         push cx
  1786.         call FoundPCX
  1787.         pop cx
  1788.         pop di
  1789.         jmp @search
  1790.  
  1791. @AU:    cmp ax,'.s'
  1792.         ja @MOD
  1793.         jnz @search
  1794.         cmp bx,'nd'
  1795.         jnz @search
  1796.         mov x,di
  1797.         push di
  1798.         push cx
  1799.         call WriteAU
  1800.         pop cx
  1801.         pop di
  1802.         jmp @search
  1803. @MOD:   cmp ax,'32'
  1804.         ja @CHN
  1805.         cmp al,'0'
  1806.         jb @search
  1807.         cmp ah,'1'
  1808.         jb @search
  1809.         cmp bx,'CH'
  1810.         jnz @CHN
  1811.         mov x,di
  1812.         cmp al,'9'
  1813.         ja @CHN
  1814.         sub ah,030h         {Convert chars in AX to normal word}
  1815.         sub al,030h
  1816.         mov dl,al
  1817.         mov al,ah
  1818.         xor ah,ah
  1819.         mov bl,10
  1820.         mul bl
  1821.         add al,dl
  1822.         shl ax,8
  1823.         mov patternsize,ax
  1824.         push di
  1825.         push cx
  1826.         call WriteMOD
  1827.         pop cx
  1828.         pop di
  1829.         jmp @search
  1830. @CHN:   cmp ah,'1'
  1831.         jb @search
  1832.         cmp ah,'9'
  1833.         ja @BMOD
  1834.         cmp al,'C'
  1835.         jnz @BMOD
  1836.         cmp bx,'HN'
  1837.         jnz @search
  1838.         mov x,di
  1839.         shr ax,8
  1840.         sub al,030h
  1841.         shl ax,8
  1842.         mov patternsize,ax
  1843.         push di
  1844.         push cx
  1845.         call WriteMOD
  1846.         pop cx
  1847.         pop di
  1848.         jmp @search
  1849. @BMOD:  cmp ax,'2S'
  1850.         ja @AMF
  1851.         cmp bx,'TM'
  1852.         jnz @search
  1853.         mov x,di
  1854.         push di
  1855.         push cx
  1856.         call WriteSTM
  1857.         pop cx
  1858.         pop di
  1859.         jmp @search
  1860. @AMF:   cmp ax,'AM'
  1861.         ja @BMP
  1862.         jb @search
  1863.         cmp bh,'F'
  1864.         jnz @search
  1865.         mov x,di
  1866.         push di
  1867.         push cx
  1868.         call WriteAMF
  1869.         pop cx
  1870.         pop di
  1871.         jmp @search
  1872. @BMP:   cmp ax,'BM'
  1873.         ja @CMF
  1874.         jb @search
  1875.         mov x,di
  1876.         push di
  1877.         push cx
  1878.         call WriteBMP
  1879.         pop cx
  1880.         pop di
  1881.         jmp @search
  1882. @CMF:   cmp ax,'CT'
  1883.         ja @VOC
  1884.         jb @search
  1885.         cmp bx,'MF'
  1886.         jnz @search
  1887.         mov x,di
  1888.         push di
  1889.         push cx
  1890.         call WriteCMF
  1891.         pop cx
  1892.         pop di
  1893.         jmp @search
  1894. @VOC:   cmp ax,'Cr'
  1895.         ja @DMF
  1896.         jb @search
  1897.         cmp bx,'ea'
  1898.         jnz @search
  1899.         mov x,di
  1900.         push di
  1901.         push cx
  1902.         call WriteVOC
  1903.         pop cx
  1904.         pop di
  1905.         jmp @search
  1906. @DMF:   cmp ax,'DD'
  1907.         ja @MDL
  1908.         jb @search
  1909.         cmp bx,'MF'
  1910.         jnz @search
  1911.         mov x,di
  1912.         push di
  1913.         push cx
  1914.         call WriteDMF
  1915.         pop cx
  1916.         pop di
  1917.         jmp @search
  1918. @MDL:   cmp ax,'DM'
  1919.         ja @XM
  1920.         jb @search
  1921.         cmp bx,'DL'
  1922.         jnz @search
  1923.         mov x,di
  1924.         push di
  1925.         push cx
  1926.         call WriteMDL
  1927.         pop cx
  1928.         pop di
  1929.         jmp @search
  1930. @XM:    cmp ax,'Ex'
  1931.         ja @FAR
  1932.         jb @search
  1933.         cmp bx,'te'
  1934.         jnz @AMS
  1935.         jnz @search
  1936.         mov x,di
  1937.         push di
  1938.         push cx
  1939.         call WriteXM
  1940.         pop cx
  1941.         pop di
  1942.         jmp @search
  1943. @AMS:   cmp bx,'tr'
  1944.         jnz @search
  1945.         mov x,di
  1946.         push di
  1947.         push cx
  1948.         call WriteAMS
  1949.         pop cx
  1950.         pop di
  1951.         jmp @search
  1952. @FAR:   cmp ax,'FA'
  1953.         ja @FLT4
  1954.         jb @search
  1955.         cmp bx,'R■'
  1956.         jnz @search
  1957.         mov x,di
  1958.         push di
  1959.         push cx
  1960.         call WriteFAR
  1961.         pop cx
  1962.         pop di
  1963.         jmp @search
  1964. @FLT4:  cmp ax,'FL'
  1965.         ja @IFF
  1966.         jb @search
  1967.         cmp bx,'T4'
  1968.         jnz @FLT8
  1969.         mov patternsize,1024
  1970.         mov x,di
  1971.         push di
  1972.         push cx
  1973.         call WriteMOD
  1974.         pop cx
  1975.         pop di
  1976.         jmp @search
  1977. @FLT8:  cmp bx,'T8'
  1978.         jnz @search
  1979.         mov patternsize,2048
  1980.         mov x,di
  1981.         push di
  1982.         push cx
  1983.         call WriteMOD
  1984.         pop cx
  1985.         pop di
  1986.         jmp @search
  1987. @IFF:   cmp ax,'FO'
  1988.         ja @FNK
  1989.         jb @search
  1990.         cmp bx,'RM'
  1991.         jnz @search
  1992.         mov x,di
  1993.         push di
  1994.         push cx
  1995.         call WriteIFF
  1996.         pop cx
  1997.         pop di
  1998.         jmp @search
  1999. @FNK:   cmp ax,'Fu'
  2000.         ja @GDM
  2001.         jb @search
  2002.         cmp bx,'nk'
  2003.         jnz @search
  2004.         mov x,di
  2005.         push di
  2006.         push cx
  2007.         call WriteFNK
  2008.         pop cx
  2009.         pop di
  2010.         jmp @search
  2011. @GDM:   cmp ax,'GD'
  2012.         ja @GIF
  2013.         jb @search
  2014.         cmp bx,'M■'
  2015.         jnz @search
  2016.         mov x,di
  2017.         push di
  2018.         push cx
  2019.         call WriteGDM
  2020.         pop cx
  2021.         pop di
  2022.         jmp @search
  2023. @GIF:   cmp ax,'GI'
  2024.         ja @HMI
  2025.         jb @search
  2026.         cmp bx,'F8'
  2027.         jnz @search
  2028.         mov x,di
  2029.         push di
  2030.         push cx
  2031.         call WriteGIF
  2032.         pop cx
  2033.         pop di
  2034.         jmp @search
  2035. @HMI:   cmp ax,'HM'
  2036.         ja @D00
  2037.         jb @search
  2038.         cmp bx,'IM'
  2039.         jnz @search
  2040.         mov x,di
  2041.         push di
  2042.         push cx
  2043.         call WriteHMI
  2044.         pop cx
  2045.         pop di
  2046.         jmp @search
  2047. @D00:   cmp ax,'JC'
  2048.         ja @JPG
  2049.         jb @search
  2050.         cmp bh,'H'
  2051.         jnz @search
  2052.         mov x,di
  2053.         push di
  2054.         push cx
  2055.         call WriteD00
  2056.         pop cx
  2057.         pop di
  2058.         jmp @search
  2059. @JPG:   cmp ax,'JF'
  2060.         ja @ANM
  2061.         jb @search
  2062.         cmp bx,'IF'
  2063.         jnz @search
  2064.         mov x,di
  2065.         push di
  2066.         push cx
  2067.         call WriteJPG
  2068.         pop cx
  2069.         pop di
  2070.         jmp @search
  2071. @ANM:   cmp ax,'LP'
  2072.         ja @MK2
  2073.         jb @search
  2074.         cmp bx,'F '
  2075.         jnz @search
  2076.         mov x,di
  2077.         push di
  2078.         push cx
  2079.         call WriteANM
  2080.         pop cx
  2081.         pop di
  2082.         jmp @search
  2083. @MK2:   cmp ax,'M!'
  2084.         ja @MK1
  2085.         jb @search
  2086.         cmp bx,'K!'
  2087.         jnz @search
  2088.         mov patternsize,1024
  2089.         mov x,di
  2090.         push di
  2091.         push cx
  2092.         call WriteMOD
  2093.         pop cx
  2094.         pop di
  2095.         jmp @search
  2096. @MK1:   cmp ax,'M.'
  2097.         ja @ULT
  2098.         jb @search
  2099.         cmp bx,'K.'
  2100.         jnz @search
  2101.         mov patternsize,1024
  2102.         mov x,di
  2103.         push di
  2104.         push cx
  2105.         call WriteMOD
  2106.         pop cx
  2107.         pop di
  2108.         jmp @search
  2109. @ULT:   cmp ax,'MA'
  2110.         ja @MTM
  2111.         jb @search
  2112.         cmp bx,'S_'
  2113.         jnz @search
  2114.         mov x,di
  2115.         push di
  2116.         push cx
  2117.         call WriteULT
  2118.         pop cx
  2119.         pop di
  2120.         jmp @search
  2121. @MTM:   cmp ax,'MT'
  2122.         ja @MUS
  2123.         jb @search
  2124.         cmp bh,'M'
  2125.         jnz @MIDI
  2126.         mov x,di
  2127.         push di
  2128.         push cx
  2129.         call WriteMTM
  2130.         pop cx
  2131.         pop di
  2132.         jmp @search
  2133. @MIDI:  cmp bx,'hd'
  2134.         jnz @search
  2135.         mov x,di
  2136.         push di
  2137.         push cx
  2138.         call WriteMIDI
  2139.         pop cx
  2140.         pop di
  2141.         jmp @search
  2142. @MUS:   cmp ax,'MU'
  2143.         ja @MXM
  2144.         jb @search
  2145.         cmp bx,$531A {S,$1A}
  2146.         jnz @search
  2147.         mov x,di
  2148.         push di
  2149.         push cx
  2150.         call WriteMUS
  2151.         pop cx
  2152.         pop di
  2153.         jmp @search
  2154. @MXM:   cmp ax,'MX'
  2155.         ja @OCTA
  2156.         jb @search
  2157.         cmp bx,$4D00
  2158.         jnz @search
  2159.         mov x,di
  2160.         push di
  2161.         push cx
  2162.         call WriteMXM
  2163.         pop cx
  2164.         pop di
  2165.         jmp @search
  2166. @OCTA:  cmp ax,'OC'
  2167.         ja @PAC
  2168.         jb @search
  2169.         cmp bx,'TA'
  2170.         jnz @search
  2171.         mov patternsize,2048
  2172.         mov x,di
  2173.         push di
  2174.         push cx
  2175.         call WriteMOD
  2176.         pop cx
  2177.         pop di
  2178.         jmp @search
  2179. @PAC:   cmp ax,'PA'
  2180.         ja @PSM
  2181.         jb @search
  2182.         cmp bx,'CG'
  2183.         jnz @search
  2184.         mov x,di
  2185.         push di
  2186.         push cx
  2187.         call WritePAC
  2188.         pop cx
  2189.         pop di
  2190.         jmp @search
  2191. @PSM:   cmp ax,'PS'
  2192.         ja @PTM
  2193.         jb @search
  2194.         cmp bx,'M '
  2195.         jnz @search
  2196.         mov x,di
  2197.         push di
  2198.         push cx
  2199.         call WritePSM
  2200.         pop cx
  2201.         pop di
  2202.         jmp @search
  2203. @PTM:   cmp ax,'PT'
  2204.         ja @RAD
  2205.         jb @search
  2206.         cmp bx,'MF'
  2207.         jnz @search
  2208.         mov x,di
  2209.         push di
  2210.         push cx
  2211.         call WritePTM
  2212.         pop cx
  2213.         pop di
  2214.         jmp @search
  2215. @RAD:   cmp ax,'RA'
  2216.         ja @RIFF
  2217.         jb @search
  2218.         cmp bh,'D'
  2219.         jnz @search
  2220.         mov x,di
  2221.         push di
  2222.         push cx
  2223.         call WriteRAD
  2224.         pop cx
  2225.         pop di
  2226.         jmp @search
  2227. @RIFF:  cmp ax,'RI'
  2228.         ja @SAdT
  2229.         jb @search
  2230.         cmp bx,'FF'
  2231.         jnz @RIX
  2232.         mov x,di
  2233.         push di
  2234.         push cx
  2235.         call FoundRIFF
  2236.         pop cx
  2237.         pop di
  2238.         jmp @search
  2239. @RIX:   cmp bx,'X3'
  2240.         jnz @search
  2241.         mov x,di
  2242.         push di
  2243.         push cx
  2244.         call WriteRIX
  2245.         pop cx
  2246.         pop di
  2247.         jmp @search
  2248. @SAdT:  cmp ax,'SA'
  2249.         ja @S3M
  2250.         jb @search
  2251.         cmp bx,'dT'
  2252.         jnz @search
  2253.         mov x,di
  2254.         push di
  2255.         push cx
  2256.         call WriteSAdT
  2257.         pop cx
  2258.         pop di
  2259.         jmp @search
  2260. @S3M:   cmp ax,'SC'
  2261.         ja @UNI
  2262.         jb @search
  2263.         cmp bx,'RM'
  2264.         jnz @search
  2265.         mov x,di
  2266.         push di
  2267.         push cx
  2268.         call WriteS3M
  2269.         pop cx
  2270.         pop di
  2271.         jmp @search
  2272. @UNI:   cmp ax,'UN'
  2273.         ja @DLZ
  2274.         jb @search
  2275.         cmp bh,'0'
  2276.         jnz @search
  2277.         mov x,di
  2278.         push di
  2279.         push cx
  2280.         call WriteUNI
  2281.         pop cx
  2282.         pop di
  2283.         jmp @search
  2284. @DLZ:   cmp ax,'dl'
  2285.         ja @STM2
  2286.         jb @search
  2287.         cmp bh,'z'
  2288.         jnz @search
  2289.         mov x,di
  2290.         push di
  2291.         push cx
  2292.         call WriteDLZ
  2293.         pop cx
  2294.         pop di
  2295.         jmp @search
  2296. @STM2:  cmp ax,'eP'
  2297.         ja @STM
  2298.         jb @search
  2299.         cmp bx,'ro'
  2300.         jnz @search
  2301.         mov x,di
  2302.         push di
  2303.         push cx
  2304.         call WriteSTM
  2305.         pop cx
  2306.         pop di
  2307.         jmp @search
  2308. @STM:   cmp ax,'ea'
  2309.         ja @MOV
  2310.         jb @search
  2311.         cmp bx,'m!'
  2312.         jnz @search
  2313.         mov x,di
  2314.         push di
  2315.         push cx
  2316.         call WriteSTM
  2317.         pop cx
  2318.         pop di
  2319.         jmp @search
  2320. @MOV:   cmp ax,'md'
  2321.         jnz @search
  2322.         cmp bx,'at'
  2323.         jnz @search
  2324.         mov x,di
  2325.         push di
  2326.         push cx
  2327.         call WriteMOV
  2328.         pop cx
  2329.         pop di
  2330.         jmp @search
  2331. @nothing:
  2332. end;
  2333.  
  2334. Begin {Main Program}
  2335.   if IsVga then
  2336.     begin
  2337.       asm
  2338.         mov ax,3h
  2339.         int 10h
  2340.       end;
  2341. {$IFNDEF DEBUG}
  2342.       asm push cs end; {Well...this seems to be a HUGE error in TP}
  2343.       SetFont;
  2344. {$ENDIF}
  2345.       CursorOff;
  2346.       filenum:=0;
  2347.       GetMem(pFileName,80);
  2348.         begin
  2349.           If (GetArgCount = 0) Then begin
  2350.                                       DisplayHelp;
  2351.                                       if option[1] = #0 then SmoothExit;
  2352.                                     end
  2353.                                Else begin
  2354.                                       GetMem(pP,80); {Reserve some memory for commandline string}
  2355.                                       GetArgStr(pp,1,80);  {Filename, specified at commandline}
  2356.                                       option[1]:=StrPas(PP);
  2357.                                       if option[1]='*' then option[1]:='*.*';
  2358.                                       GetArgStr(PP,2,80);  {Filename, specified at commandline}
  2359.                                       option[2]:=StrPas(PP);
  2360.                                       GetArgStr(PP,3,80);  {Filename, specified at commandline}
  2361.                                       option[3]:=StrPas(PP);
  2362.                                     end;
  2363.           for y:=2 to 24 do
  2364.           FastWrite('                                                                                 ',1,y,121);
  2365.           FastWrite (' Fast Module Extractor '+version+'                                                     ',1,1,79);
  2366.           FastWrite ('                  The easy way to extract music and graphics                    ',1,25,30);
  2367.           for y:=50 to 50+24 do FastWrite('▒',y,7,112);
  2368.           for y:=50 to 50+24 do FastWrite('▒',y,9,112);
  2369.           FastWrite(' Processing:           bytes of           bytes',1,7,121);
  2370.           FastWrite('%',79,7,126);
  2371.           FastWrite(' Processing:           bytes of           bytes',1,9,121);
  2372.           FastWrite('%',79,9,126);
  2373.           drawline(13,125);
  2374.           drawline (15,117);
  2375.           PP:=Pas2PChar(option[1]);
  2376.           FilesInDir:=0;
  2377.           doserror:=FindFirst (PP, 0, Search);
  2378.           while doserror = 0 do
  2379.            begin
  2380.              inc(FilesInDir);
  2381.              doserror:=FindNext(search);
  2382.            end;
  2383.  
  2384.           doserror:=FindFirst (PP, 0, Search);
  2385.           FileSplit (PP, D, N, E);
  2386.           filename:=StrPas(D);
  2387.           filename:=filename+Search.Name;
  2388.           if option[2,1]='#' then
  2389.             begin
  2390.               FastWrite('Partial copy mode',2,19,113);
  2391.               FastWrite('Copying from: '+ search.name,2,21,113);
  2392.               Pfilename:=Pas2PChar(filename);
  2393.               infile2:=h_Openfile(PFilename,0);
  2394.               PartialCopy;
  2395.               h_closefile(infile2);
  2396.               waitforkey;
  2397.           end
  2398.           else
  2399.           if doserror=0 then
  2400.             begin
  2401.               for fx:= 1 to FilesInDir Do
  2402.                 begin
  2403.                   upper(filename);
  2404.                   Pfilename:=Pas2PChar(filename);
  2405.                   infile1:=h_Openfile(PFilename,0);
  2406.                   Attr:=GetFileAttr(Pfilename);
  2407.                   if Attr and faReadOnly <> 0 then begin
  2408.                                                      Readonlyfile := True; {Remove read-only attr}
  2409.                                                      SetFileAttr(pas2pchar(filename), faArchive);
  2410.                                                    end
  2411.                   else Readonlyfile := False;
  2412.                       infile2:=h_Openfile(PFilename,0);
  2413.                       l := 0;
  2414.                       FastWrite('Filename: '+strpas(pfilename)+'                     ',2,5,127);
  2415.                       FastWrite('Files to be scanned: '+ToStr(FilesInDir - fx,0)+'      ',2,3,$7B);
  2416.                       res:=0;
  2417.                       if search.size > 0 then
  2418.                         repeat
  2419.                           res:=h_read (infile1, sample, SizeOf (sample));
  2420.                           l:=l+longint(res);
  2421.                           FastWrite ('Processing: '+ToStr(l,9),2,7,121);
  2422.                           FastWrite ('bytes of '+ToStr(search.size,9)+' bytes',24,7,121);
  2423.                           drawbar(l*100 div search.size,50,7);
  2424.                           case option[2,1] of
  2425.                           'X','x': begin
  2426.                                      FastWrite ('┤Extended mode├',65,15,117);
  2427.                                      SearchExtended;
  2428.                                    end;
  2429.                           '!':     begin
  2430.                                      FastWrite ('┤Custom mode├',67,15,117);
  2431.                                      SearchCustom;
  2432.                                    end;
  2433.                           end;
  2434. {----------------------------------------------------------------------------}
  2435.                           SearchEngine; {The central search-engine!}
  2436. {----------------------------------------------------------------------------}
  2437.                           if port[$60]=1 then SmoothExit; {Quick-escape...}
  2438.                         until res < buffer;
  2439.                       if readonlyfile Then Attr:=SetFileAttr(pas2pchar(filename), faReadonly+faArchive);
  2440.                       h_CloseFile(infile1);
  2441.                       h_CloseFile(infile2);
  2442.                       doserror:=FindNext(search);
  2443.                       filename:=StrPas(D);
  2444.                       filename:=filename+Search.Name;
  2445.                       for y:=50 to 50+24 do FastWrite('▒',y,7,112);
  2446.                 end;
  2447.               FastWrite('Scan completed',2,14,121);
  2448.               waitforkey;
  2449.             end
  2450.           else
  2451.             begin
  2452.               FastWrite('File not found',2,14,121);
  2453.               readkey;
  2454.             end;
  2455.         end;
  2456.     SmoothExit;
  2457.     end
  2458.   else FastWrite('This program requires a VGA-compatible video-board',1,1,7);
  2459. End.
  2460.