// Winamp database file reader
// ©2009 by Steffest
// http://www.steffest.com

// based on the docs found at http://gutenberg.free.fr/fichiers/SDK%20Winamp/nde_specs_v1.txt

// they are a bit outdated as each index is 8 bytes instead of 4
// also there's a datatype 12?
// the current docs only go to 11
// (12 seems to be a unicode string for the filename)



unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids, ExtCtrls, jpeg, shellapi;

type
   Tindex = Record
    offset  : longword;
    index   : longword;
  end;

  TNDEfieldheader = Record
    id          : byte;
    fieldtype   : byte;
    datasize    : array[0..1] of word;
    nextfieldpos: array[0..1] of word;
    prevfieldpos: array[0..1] of word;
    // what's up with this?
    // the array[0..1] of word should actually be a longword, but then it gets read in reversed byte order?
  end;

  TForm1 = class(TForm)
    Memo1: TMemo;
    Memo2: TMemo;
    grid: TStringGrid;
    Panel1: TPanel;
    Button: TButton;
    SaveDialog1: TSaveDialog;
    OpenDialog1: TOpenDialog;
    aboutpanel: TPanel;
    Image1: TImage;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    procedure Readindex;
    procedure ButtonClick(Sender: TObject);
    procedure readrecord(offset:integer);
    function getfield(fieldtype: integer; fieldsize:integer; rawdata:array of byte):string;
    procedure Label3Click(Sender: TObject);
  public
    datafile:string;
    data:file;
    indexfile:string;
    index:file of Tindex;
    hasfields:boolean;
    fieldcount:integer;
    debug:boolean;
    alldone:boolean;
    defaultpath:string;
  end;

  procedure XlsWriteCellLabel(XlsStream: TStream; const ACol, ARow: Word;const AValue: string);
  function SaveAsExcelFile(AGrid: TStringGrid; AFileName: string): Boolean;
  function GetCurrentUserName: string;


var
  Form1: TForm1;

implementation


{$R *.dfm}

procedure TForm1.ButtonClick(Sender: TObject);
var s:string;
begin
  debug := false;

  if debug then begin
      memo1.Show;
      memo2.Show;
  end;

  aboutpanel.SendToBack;

  if alldone then
  begin
    if savedialog1.Execute then begin
      if SaveAsExcelFile(grid, savedialog1.filename) then ShowMessage('all done!');
    end;
  end else begin
    s := trim(GetCurrentUserName);
    defaultpath := 'C:\Users\' + s + '\AppData\Roaming\Winamp\Plugins\ml\';
    opendialog1.InitialDir := defaultpath;
    datafile:='';


    if fileexists(defaultpath + 'main.dat') then
      datafile :=  defaultpath + 'main.dat'
    else begin
      showmessage('main.dat not found on default location - please select it');
      if opendialog1.Execute then datafile := opendialog1.filename;
    end;


    if (datafile <> '') then begin


      Button.Caption := 'Working ... please wait';
      grid.Show;
      application.ProcessMessages;

      // open data files
      // default is "C:\Users\Username\AppData\Roaming\Winamp\Plugins\ml\main.dat"
      
      AssignFile(data, datafile);
      reset(data,1);

      // first read fieldnames
      readrecord(8);
      hasfields := true;

      Readindex;

      CloseFile(data);

      Button.Caption := 'Export to Excel';
      alldone := true;
    end;
  end;
end;



procedure TForm1.Readindex;
var
  i:integer;
  recordcount:integer;
  d:Tindex;
begin
  indexfile := extractfilepath(datafile) + 'main.idx';
  AssignFile(index, indexfile);
  Reset(index);
    // first 8 bytes are 'NDEINDEX'
    Seek(index,1);
    Read(index,d);
    recordcount := d.offset;
    if debug then memo1.Lines.add('Database has ' + inttostr(recordcount-2) + ' records');
    i:=0;
  while (not Eof(index)) and (i2 then
    begin
      if debug then memo1.Lines.add(inttostr(d.offset));
      readrecord(d.offset);
    end;
  end;
  CloseFile(index);


end;


procedure TForm1.readrecord(offset:integer);
var
  s:string;
  d:TNDEfieldheader;
  a:array[1..2048] of byte;
  datasize:integer;
  nextoffset:integer;
  fieldnr:integer;
  fieldtype:integer;
  row:integer;
  currentcol:integer;
begin
  nextoffset := offset ;
  fieldnr:=0;
  row := grid.RowCount-2;
  grid.RowCount := row+3;

  while nextoffset>0 do
  begin
    inc(fieldnr);
    seek(data,nextoffset);
    blockread(data,d,sizeof(d));

    currentcol := d.id;
    fieldtype := d.fieldtype;
    datasize := (d.datasize[1] * 65536) + d.datasize[0];
    nextoffset := (d.nextfieldpos[1] * 65536) + d.nextfieldpos[0];

    if debug then begin
      s := 'record ' + inttostr(d.id)+ ' of type ' + inttostr(d.fieldtype)+ ' size: ' + inttostr(datasize) + ' next: ' + inttostr(nextoffset);
      memo2.Lines.Add(s);
    end;

    if datasize>2048 then datasize:=2048;
    blockread(data,a,datasize);

    s := getfield(fieldtype,datasize,a);

    if not hasfields then begin
      fieldcount := fieldnr;
      grid.ColCount := fieldcount;
    end;
    grid.Cells[currentcol,row] := s;

    if debug then memo2.Lines.Add('Data:' + s);

    if fieldnr>fieldcount then nextoffset := 0;

  end;


end;

function Tform1.getfield(fieldtype: integer; fieldsize:integer; rawdata:array of byte):string;
var
  w:word;
  s:string;
  i:integer;
  datasize:integer;
  c:integer;
begin
  s := '';

  // fieldtype 12 for filenames ? - handle as string
  if fieldtype=12 then fieldtype := 3;

  case fieldtype of
  0: //FIELD_COLUMN
    begin
      datasize := rawdata[2];
      for i := 3 to datasize+2 do
      begin
         s := s + chr(rawdata[i]);
      end;
    end;

  3: //FIELD_STRING
    begin
      datasize := (rawdata[1]*256) + rawdata[0];
      c := 1;
      w := 0;
      // there's seems to be a word value "FFFE" before each string?
      // ignoring for now
      for i := 4 to (datasize+1) do
      begin
        case c of
          1: w := rawdata[i];
          2:begin
             w := (rawdata[i]*256) + w;
             s := s + chr(w);
             c:=0
          end;
        end;
        inc(c);
      end;
    end;

   4: //FIELD_INTEGER
   begin
    i := (rawdata[1]*256) + rawdata[0] ;
    s := inttostr(i);
   end;
   10: //FIELD_DATETIME
   begin
    i := (rawdata[1]*256) + rawdata[0] ;
    s := inttostr(i);
   end;
   11: //FIELD_LENGTH
   begin
    i := (rawdata[1]*256) + rawdata[0] ;
    s := inttostr(i);
   end;

  else
    s := 'Unknown data type ' + inttostr(fieldtype);
  end;
  result := s;
end;



procedure XlsWriteCellLabel(XlsStream: TStream; const ACol, ARow: Word;
  const AValue: string);
var
  L: Word;
const
  {$J+}
  CXlsLabel: array[0..5] of Word = ($204, 0, 0, 0, 0, 0);
  {$J-}
begin
  L := Length(AValue);
  CXlsLabel[1] := 8 + L;
  CXlsLabel[2] := ARow;
  CXlsLabel[3] := ACol;
  CXlsLabel[5] := L;
  XlsStream.WriteBuffer(CXlsLabel, SizeOf(CXlsLabel));
  XlsStream.WriteBuffer(Pointer(AValue)^, L);
end;


function SaveAsExcelFile(AGrid: TStringGrid; AFileName: string): Boolean;
const
  {$J+} CXlsBof: array[0..5] of Word = ($809, 8, 00, $10, 0, 0); {$J-}
  CXlsEof: array[0..1] of Word = ($0A, 00);
var
  FStream: TFileStream;
  I, J: Integer;
begin
  Result := False;
  FStream := TFileStream.Create(PChar(AFileName), fmCreate or fmOpenWrite);
  try
    CXlsBof[4] := 0;
    FStream.WriteBuffer(CXlsBof, SizeOf(CXlsBof));
    for i := 0 to AGrid.ColCount - 1 do
      for j := 0 to AGrid.RowCount - 1 do
        XlsWriteCellLabel(FStream, I, J, AGrid.cells[i, j]);
    FStream.WriteBuffer(CXlsEof, SizeOf(CXlsEof));
    Result := True;
  finally
    FStream.Free;
  end;
end;

function GetCurrentUserName: string;
const
  cnMaxUserNameLen = 254;
var
  sUserName: string;
  dwUserNameLen: DWORD;
begin
  dwUserNameLen := cnMaxUserNameLen - 1;
  SetLength(sUserName, cnMaxUserNameLen);
  GetUserName(PChar(sUserName), dwUserNameLen);
  SetLength(sUserName, dwUserNameLen);
  Result := sUserName;
end;

procedure TForm1.Label3Click(Sender: TObject);
begin
 shellexecute(application.Handle,'open','http://www.steffest.com',nil,nil,0);
end;

end.