Changeset 8 for trunk


Ignore:
Timestamp:
Mar 28, 2022, 5:46:21 PM (3 years ago)
Author:
chronos
Message:
  • Modified: Converted into GUI application.
Location:
trunk
Files:
8 added
1 edited
1 moved

Legend:

Unmodified
Added
Removed

  • trunk

    • Property svn:ignore set to
      lib
      GenPlaylist
      GenPlaylist.lps
      GenPlaylist.res
      GenPlaylist.dbg

  • trunk/GenPlaylist.lpr

    r7 r8  
    11program GenPlaylist;
    22
    3 {$mode delphi}
     3{$mode objfpc}{$H+}
    44
    55uses
    6   SysUtils, Classes;
    7  
    8 function InStrArray(Value: string; StrArray: array of string): Boolean;
    9 var
    10   I: Integer;
    11 begin
    12   I := 0;
    13   while (I < Length(StrArray)) and (StrArray[I] <> Value) do Inc(I);
    14   if I < Length(StrArray) then Result := True
    15     else Result := False;
    16 end;
    17  
    18 procedure FileSearch(Files: TStringList; const PathName: string; ExtList: array of string);
    19 var
    20   Rec: TSearchRec;
    21   Path: string;
    22 begin
    23   Path := IncludeTrailingPathDelimiter(PathName);
    24   //WriteLn('Dir: ' + PathName);
    25   if FindFirst(Path + '*', faAnyFile, Rec) = 0 then
    26   try
    27     repeat
    28       //WriteLn(Rec.Name);
    29       if Rec.Name = '..' then continue
    30       else if Rec.Name = '.' then continue
    31       else if (Rec.Attr and faDirectory) > 0 then FileSearch(Files, Path + Rec.Name, ExtList)
    32       else if InStrArray(LowerCase(ExtractFileExt(Rec.Name)), ExtList) then begin
    33         //WriteLn('File: ' + Rec.Name);
    34         Files.Add(Path + Rec.Name);
    35       end;
    36     until FindNext(Rec) <> 0;
    37   finally
    38     FindClose(Rec) ;
    39   end;
    40 end;
     6  {$IFDEF UNIX}{$IFDEF UseCThreads}
     7  cthreads, clocale,
     8  {$ENDIF}{$ENDIF}
     9  Interfaces, // this includes the LCL widgetset
     10  Forms, UFormMain
     11  { you can add units after this };
    4112
    42 procedure GenerateM3U;
    43 var
    44   Files: TStringList;
    45   I: Integer;
    46 begin
    47   Files := TStringList.Create;
    48   WriteLn('#EXTM3U');
    49   FileSearch(Files, ParamStr(1), ['.mp3', '.ac3', '.flac', '.it', '.m4a', '.wma', '.s3m', '.ogg']);
    50   for I := 0 to Files.Count - 1 do
    51     WriteLn(Files[I]);
    52   Files.Free;
    53 end;
    54 
    55 function FileDate(FileName: string): TDateTime;
    56 var
    57   fa: LongInt;
    58 begin
    59   fa := FileAge(FileName);
    60   if Fa <> -1 then begin
    61     Result := FileDateToDateTime(fa);
    62   end else
    63     raise Exception.Create('File ''' + FileName + ''' not found ');
    64 end;
    65 
    66 procedure GenerateXSPF;
    67 var
    68   Files: TStringList;
    69   I: Integer;
    70   Creator: string;
    71   Album: string;
    72   Location: string;
    73   LocationOriginal: string;
    74   Title: string;
    75   Part: string;
    76   TrackNum: string;
    77   Out: Integer;
    78   NameRemoved: Boolean;
    79   RemoteName: string;
    80 begin
    81   Files := TStringList.Create;
    82   WriteLn('<?xml version="1.0" encoding="UTF-8"?>');
    83   WriteLn('<playlist version="1" xmlns="http://xspf.org/ns/0/">');
    84   WriteLn('<trackList>');
    85   FileSearch(Files, ParamStr(1), ['.mp3', '.ac3', '.flac', '.it', '.m4a', '.wma', '.s3m', '.ogg']);
    86   for I := 0 to Files.Count - 1 do begin
    87     RemoteName := ParamStr(2) + Copy(Files[I], Length(ParamStr(1)) + 2, High(Integer));
    88     LocationOriginal := StringReplace(RemoteName, '&', '&amp;', [rfReplaceAll]);
    89     Location := StringReplace(LocationOriginal, '_', ' ', [rfReplaceAll]);
    90     Album := ExtractFileName(ExtractFileDir(Location));
    91     NameRemoved := False;
    92    
    93     // Detect Creator from directory name
    94     if Pos(' - ', Album) > 0 then begin
    95       Creator := Copy(Album, 1, Pos(' - ', Album) - 1);
    96       Delete(Album, 1, Length(Creator) + 3);
    97     end else Creator := Album;
    98     Title := Copy(ExtractFileName(Location), 1, Length(ExtractFileName(Location)) - Length(ExtractFileExt(Location)));
    99    
    100     // Remove starting with album name from title
    101     Part := Creator + ' - ';
    102     if Copy(Title, 1, Length(Part)) = Part then begin
    103       Delete(Title, 1, Length(Part));
    104       NameRemoved := True;
    105     end;
    106      
    107     // Try to load Creator from name
    108     if (Pos(' - ', Title) > 0) and (not NameRemoved) then begin
    109       Part := Copy(Title, 1, Pos(' - ', Title) - 1);
    110       // Avoid track number which can be first title part
    111       if not TryStrToInt(Part, Out) then begin
    112         Creator := Part;
    113         Delete(Title, 1, Length(Creator) + 3);
    114       end;
    115     end;
    116     // Detect track number from title
    117     if Pos(' - ', Title) > 0 then begin
    118       TrackNum := Copy(Title, 1, Pos(' - ', Title) - 1);
    119       if TryStrToInt(TrackNum, Out) then       
    120         Delete(Title, 1, Length(TrackNum) + 3)
    121         else TrackNum := '';
    122     end else TrackNum := '';
    123    
    124     WriteLn('<track>');
    125     WriteLn('<title>' + Title + '</title>');
    126     WriteLn('<location>' + LocationOriginal + '</location>');
    127     WriteLn('<album>' + Album + '</album>');
    128     WriteLn('<creator>' + Creator + '</creator>');
    129     WriteLn('<trackNum>' + TrackNum + '</trackNum>');
    130     WriteLn('<annotation>' + FormatDateTime('yyyy-mm-dd', FileDate(Files[I])) + '</annotation>');
    131     WriteLn('</track>');
    132   end;
    133   WriteLn('</trackList>');
    134   WriteLn('</playlist>');
    135   Files.Free;
    136 end;
     13{$R *.res}
    13714
    13815begin
    139   GenerateXSPF;
     16  RequireDerivedFormResource := True;
     17  Application.Scaled:=True;
     18  Application.Initialize;
     19  Application.CreateForm(TFormMain, FormMain);
     20  Application.Run;
    14021end.
     22
     23
Note: See TracChangeset for help on using the changeset viewer.