Create a gist now

Instantly share code, notes, and snippets.

What would you like to do?
XiRip is a 1997 Turbo Pascal program that takes .xm music files and extracts the embedded instruments.
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 bjoern@hoehrmann.de. ');
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.
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment