XiRip is a 1997 Turbo Pascal program that takes .xm music files and extracts the embedded instruments.

Xirip.pas

uses StrngTol;
type
parameter=record
            FileName:String;
            ExtractPath:String;
            ShowHelpScreen:Boolean;   {/?}
            KeepInstName:boolean;     {/K}
            KeepSampName:boolean;     {/S}
            QuitOutput:Boolean;       {/Q}
          end;

InstHead=record {size:29}
           size:longint;
           name:array[0..21] of char;
           Itype:byte;
           anz:word;
         end;
{------------------------------------------}
SampHead=record {Size:40}
           Length:longint;
           Res:array[0..13] of char;
           name:array[0..21] of char;
         end;
{------------------------------------------}
samp=record {size:230}
       Unknown:array[0..229] of byte;
     end;

var f,nf:file;
    w,anzPat:word;
    b,AnzInst:byte;
    c:char;
    h,i,j,k:integer;
    buf:array[0..32767] of char;
    xiheader:array[0..65] of char;
    rsize,sz:longint;
    Sample:Samp;
    MSampleHead:array[1..16] of SampHead;
    Instrument:InstHead;
    s,s2,fn:string;
    SampleHeaderSize:longint;
    InstSizeGes:longint;
    Param:Parameter;

function ToHex(b:byte):string;
var hex:array[0..15] of char;
    ch1,ch2:char;
    i:integer;

begin
  for i:=0 to 9 do hex[i]:=chr(48+i);
  for i:=10 to 15 do hex[i]:=chr(55+i);
  ch1:=hex[b div 16];
  ch2:=hex[b mod 16];
  Tohex:=ch1+ch2;
end;

procedure SetParam;
var ap:string;
    i:integer;

begin
   ap:='';
   if paramcount=0 then Param.ShowHelpScreen:=true;
   for i:=1 to ParamCount do ap:=ap+ParamStr(i)+' ';
   ap:=StrUpperCase(ap);
   if pos('/?',ap)<>0 then begin Param.ShowHelpScreen:=true; delete(ap,pos('/?',ap),3);end;
   if pos('/K',ap)<>0 then begin Param.KeepInstName:=true;   delete(ap,pos('/K',ap),3);end;
   if pos('/S',ap)<>0 then begin Param.KeepSampName:=true;   delete(ap,pos('/S',ap),3);end;
   if pos('/',ap)<>0 then Param.ShowHelpScreen:=True;
   if pos(' ',ap)<>0 then begin
     Param.FileName:=copy(ap,1,pos(' ',ap)-1);
     delete(ap,1,pos(' ',ap));
   end;
   if length(ap)<>0 then begin
     Param.ExtractPath:=copy(ap,1,length(ap)-1);
     delete(ap,1,length(ap));
     if Param.ExtractPath[length(Param.ExtractPath)]<>'\' then Param.ExtractPath:=Param.ExtractPath+'\';
   end else Param.ExtractPath:='';
   if length(ap)<>0 then Param.ShowHelpScreen:=True;
end;

procedure ShowHelpScreen;
begin
  WriteLn('                                                                               ');
  WriteLn(' XiRip v1.0                              Copyright (c) 1997 by Bjoern Hoehrmann');
  WriteLn(' ──────────────────────────────────────────────────────────────────────────────');
  WriteLn('  XiRip is a little utility to extract Extended Instruments from FastTracker''s ');
  WriteLn('  Extended modules.                                                            ');
  WriteLn(' ──────────────────────────────────────────────────────────────────────────────');
  WriteLn('  /?  -  Shows this little help screen                                         ');
  WriteLn('  /K  -  Keeps the instrument name                                             ');
  WriteLn('  /S  -  Keeps the sample names                                                ');
  WriteLn(' ──────────────────────────────────────────────────────────────────────────────');
  WriteLn('  Usage: XIRIP.EXE MODULE.XM [/K][/S][/I][/Q][path for .xi]                    ');
  WriteLn(' ──────────────────────────────────────────────────────────────────────────────');
  WriteLn('  I hope this program will help you composing high quality songs, but please,  ');
  WriteLn('  if you use any instrument in your songs, give the creator of the instrument  ');
  WriteLn('  a credit in your song.                                                       ');
  WriteLn('  For any comment or a bug report contact [email protected].                 ');
end;

begin
  SetParam;
  if Param.ShowHelpScreen then begin ShowHelpScreen;halt;end;
  s2:=Param.Filename;
  delete(s2,pos('.',s2),3);
  if length(s2)>6 then delete(s2,7,255);
  assign(f,Param.Filename);
  reset(f,1);
  seek(f,70);
  BlockRead(f,anzPat,2);
  BlockRead(f,Anzinst,1);
  seek(f,336);
  for i:=1 to anzPat do begin
    seek(f,Filepos(f)+7);
    blockread(f,w,2);
    seek(f,filepos(f)+w);
  end;
  {--<---Instrument Extraction starts here--->--}
  for k:=1 to anzinst do begin
    fn:=s2+toHex(k)+'.XI';
    assign(nf,Param.ExtractPath+fn);
    BlockRead(f,Instrument,sizeof(instrument));
    BlockRead(f,SampleHeaderSize,4);
    WriteLn(k,': ',instrument.name,': ',FilePos(f));
    if Instrument.anz=0 then continue;
    {-------------------------------------------------}
    rewrite(nf,1);
    for h:=1 to 22 do begin
{      if instrument.name[h]=#$0 then instrument.name[h]:=#$20;
      if instrument.name[h]<>#$20 then break;}
      if (length(fn)>=h) then Instrument.name[h-1]:=upcase(fn[h])
      else Instrument.name[h-1]:=#$20;
    end;
    s:='Extended Instrument: '+Instrument.name+#$1A+'FastTracker v2.00   '+#$02+#$01;
    for j:=0 to 65 do xiheader[j]:=s[j+1];
    BlockWrite(nf,xiheader,sizeOf(xiheader));
    BlockRead(f,sample,sizeof(sample));
    BlockWrite(nf,Sample,sizeof(sample));
    BlockWrite(nf,instrument.anz,2);
    for i:=1 to instrument.anz do begin
      BlockRead(f,MSampleHead[i],sizeof(samphead));
{      for h:=21 downto 0 do begin
        if MSampleHead[i].name[h]=#$20 then MSampleHead[i].name[h]:=#$0;
        if MSampleHead[i].name[h]<>#$0 then break;
      end;}
      for h:=1 to 22 do begin
        if (length(Param.Filename)>=h) and (i=1) then MSampleHead[i].name[h-1]:=upcase(Param.Filename[h])
        else MSampleHead[i].name[h-1]:=#0;
      end;
      BlockWrite(nf,MSampleHead[i],sizeof(samphead));
    end;
    {-------------------------------------------------}
    InstSizeGes:=0;
    for i:=1 to instrument.anz do begin
      rsize:=MSampleHead[i].length;
      inc(InstSizeGes,MSampleHead[i].length);
      repeat
        if rsize>32767 then sz:=32767 else sz:=rsize;
        BlockRead(f,buf,sz);
        BlockWrite(nf,buf,sz);
        dec(rsize,sz);
      until rsize=0;
    end;
    {-------------------------------------------------}
    if (FileSize(nf)<=400) or (InstSizeGes<50) then begin close(nf);erase(nf);end
   else close(nf);
  end;
  close(f);
end.