Tool that displays VOC (Creative Labs) voice file information I wrote in 1994

dumpvoc.pas

uses Dos,Objects,XVoc,XIO;

var
  f:FNameStr;
  H:TVOCHeader;
  Block:byte;
  s:string[20];
  T:TDosStream;
  procedure DumpBlock(b:byte);
  var
    vh:TVOCBlock;
    vdh:TVoiceData;
    vch:TVoiceCont;
    vsh:TSilence;
    vmh:TMarker;
    vrh:TRepeat;
    vxh:TExtVoice;
  begin
    case b of
      vbTerminator : writeln('End of file');
      vbVoiceData  : begin
                       T.Read(vdh,SizeOf(vdh));
                       writeln('Length = ',vdh.Len-2:5,
                               ' KHz = ',TC2Khz(vdh.KHz):5,
                               ' Pack = ',PackStr[vdh.Pack]);
                       T.Seek(T.GetPos+vdh.Len-sizeof(vdh)-1);
                     end;
      vbVoiceCont : begin
                      T.Read(vch,SizeOf(vch));
                      writeln('Length = ',vch.Len-2:5);
                      T.Seek(T.GetPos+vch.Len-sizeof(vch)-1);
                    end;
      vbSilence   : begin
                      T.Read(vsh,SizeOf(vsh));
                      writeln('Period = ',vsh.Period:5,
                              ' KHz = ',vsh.KHz:5);
                    end;
      vbMarker    : begin
                      T.Read(vmh,SizeOf(vmh));
                      writeln('Marker = ',vmh.Marker);
                    end;
      vbText      : begin
                      T.Read(vh,sizeof(vh));
                      T.Seek(T.GetPos+vh.Len-sizeof(vh)-1);
                    end;
      vbRepeat    : begin
                      T.Read(vrh,SizeOf(vrh));
                      writeln('Count = ',vrh.Count);
                    end;
      vbUntil     : begin
                      T.Read(vh,vh.len-sizeof(vh)-1);
                      writeln;
                    end;
      vbExtended  : begin
                      T.Read(vxh,SizeOf(vxh));
                      writeln('Length = ',vxh.Len-2:5,
                            ' - no more info');
                      T.Seek(T.GetPos+vxh.Len-sizeof(vxh)-1);
                    end;
    end; {case}
  end;
begin
  XAppInit('VOC Dumper','1.00b','SSG',1,'vocname[.VOC]');
  f := XAddExt(FExpand(ParamStr(1)),'.VOC');
  byte(s[0]) := 19;
  T.Init(f,stOpenRead);
  if T.Status = stOK then begin
    T.Read(H,SizeOf(H));
    Move(H.Desc,s[1],length(s));
    writeln('Header       = ',s);
    writeln('Version      = ',XGetVersion(H.Version));
    writeln('Data offset  = ',H.DataOffs);
    writeln('Valid header = ',ValidVOCHdr(H));
    T.Seek(H.DataOffs);
    repeat
      writeln;
      T.Read(block,1);
      if block > MaxBlocks then XAbort('Unknown block-type');
      write(VOCBlock[block],' - ');
      DumpBlock(block);
    until block = vbTerminator;
  end;
  T.Done;
  writeln;
  writeln('SSG operation complete');
end.