home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: Multimed / Multimed.zip / mp3osr05.zip / src / reports.pas < prev    next >
Pascal/Delphi Source File  |  1999-12-28  |  13KB  |  503 lines
  1. (*
  2.  * part of MPEG searcher project
  3.  *  (c) 1999 by Alexander Trunov, 2:5069/10, jnc@mail.ru
  4.  *)
  5.  
  6. {$I-}
  7. unit Reports;
  8.  
  9. interface
  10.  
  11. uses
  12.   Objects, mp3lb, ID3v1, MsgBox, DOS, StdDlg, Dialogs, App, Views,
  13.   SortType, Macroz, MacrozTV
  14.   {$IFNDEF fpc}, EditChD{$ENDIF}
  15.   {$IFDEF virtualpascal}, Use32{$ENDIF}
  16.   ;
  17.  
  18. type
  19.   TFNGetMP3Tag = function(FN: string): PjID3v1;
  20.  
  21. function SaveFilesBBS(const FN: FNameStr; mp3s: PCollection;
  22.   GetMP3Tag: TFNGetMP3Tag): Boolean;
  23. function SaveM3U(const FN: FNameStr; mp3s: PCollection;
  24.   GetMP3Tag: TFNGetMP3Tag): Boolean;
  25. function SaveListWhole(FN, templateFN: FNameStr; mp3s: PCollection;
  26.   GetMP3Tag: TFNGetMP3Tag): Boolean;
  27. function SaveSeparatedList(FN, templateFN: FNameStr; mp3s: PCollection;
  28.   GetMP3Tag: TFNGetMP3Tag; twoItemsRec: TTwoItemsRec): Boolean;
  29. procedure MakeStandardMacros(const tag: PjID3v1; mc: PMacrosEngine;
  30.   var totalSize: Longint; Filename: string);
  31.  
  32. implementation
  33.  
  34. uses
  35.   Config, Wizard, StatusW, MP3List, Drivers, Gadgets, Codepage,
  36.   Sortings
  37.   {$ifdef win32}, Windows, Strings {$endif}
  38.   ;
  39.  
  40. {$I nonfpc.inc}
  41. type
  42.   PMP3Searcher = ^TMP3Searcher;
  43.   TMP3Searcher = object(TApplication)
  44.     StatusWindow: PStatusWindow;
  45.     MP3ListDialog: PMP3List;
  46.   end;
  47.  
  48. // from mp3list (c) by sk [2:6033/27]
  49. function MakeShortName(const LongName: string): string;
  50. var
  51.   AName, AShortName: PChar;
  52. begin
  53. {$ifdef win32}
  54.   GetMem(AName, Length(LongName) + 1);
  55.   GetMem(AShortName, 4096);
  56.  
  57.   StrPCopy(AName, LongName);
  58.  
  59.   GetShortPathName(AName, AShortName, 4095);
  60.  
  61.   Result := StrPas(AShortName);
  62.  
  63.   FreeMem(AShortName, 4096);
  64.   FreeMem(AName, Length(LongName) + 1);
  65. {$else}
  66.   Result := LongName;
  67. {$endif}
  68. end;
  69.  
  70. procedure MakeStandardMacros(const tag: PjID3v1; mc: PMacrosEngine;
  71.   var totalSize: Longint; Filename: string);
  72. var
  73.   Size, i, playTime, playTimeSec: Longint;
  74.   line: string;
  75. begin
  76.   if Length(tag^.Songname) = 0 then
  77.     tag^.Songname := '?';
  78.   if Length(tag^.Artist) = 0 then
  79.     tag^.Artist := '?';
  80.   if Length(tag^.Album) = 0 then
  81.     tag^.Album := '?';
  82.  
  83.   mc^.AddMacro('@title', tag^.Songname, mcUser);
  84.   mc^.AddMacro('@album', tag^.Album, mcUser);
  85.   mc^.AddMacro('@artist', tag^.Artist, mcUser);
  86.   mc^.AddMacro('@comment', tag^.Comment, mcUser);
  87.   mc^.AddMacro('@year', tag^.Year, mcUser);
  88. //  Size := Wizard.GetFileSize(mp3^.Filename);
  89.   Size := tag^.Size;
  90.   inc(totalSize, Size);
  91.   mc^.AddMacro('@size', Long2Str(Size), mcUser);
  92.   if tplMakeShortFilenames then
  93.     line := JustFilename(MakeShortName(Filename))
  94.   else
  95.     line := JustFilename(Filename);
  96.   mc^.AddMacro('@filename', line, mcUser);
  97.   case tag^.hLayer of
  98.     $01: line := mcLayerI;
  99.     $02: line := mcLayerII;
  100.     $03: line := mcLayerIII;
  101.     else line := mcLayerUnknown;
  102.   end;
  103.   mc^.AddMacro('@layer', line, mcUser);
  104.   case tag^.hMPEGVersion of
  105.     $10: line := mcMpeg10;
  106.     $20: line := mcMpeg20;
  107.     $25: line := mcMpeg25;
  108.     else line := mcMpegUnknown;
  109.   end;
  110.   mc^.AddMacro('@mpegversion', line, mcUser);
  111.   case tag^.hMode of
  112.     cmStereo: line := mcModeStereo;
  113.     cmJointStereo: line := mcModeJointStereo;
  114.     cmDualChannel: line := mcModeDualChannel;
  115.     cmSingleChannel: line := mcModeSingleChannel;
  116.   end;
  117.   mc^.AddMacro('@mode', line, mcUser);
  118.   mc^.AddMacro('@samplerate', Long2Str(tag^.hSampleRate), mcUser);
  119.   mc^.AddMacro('@bitrate', Long2Str(tag^.hBitRate), mcUser);
  120.   if tag^.tagExists then
  121.     Size := 128
  122.   else
  123.     Size := 0;
  124.   playTime := 8 * (tag^.Size - Size - tag^.RiffHeaderSize)
  125.     div tag^.hBitrate div 1000;
  126.   playTimeSec := playTime mod 60;
  127.   mc^.AddMacro('@playtimesec', Long2Str(playTimeSec),
  128.     mcUser);
  129.   mc^.AddMacro('@playtimemin', Long2Str((playTime - playTimeSec) div 60),
  130.     mcUser);
  131. end;
  132.  
  133. function MakeCollectionFromFile(const FN: FNameStr): PStringCollection;
  134. var
  135.   inf: Text;
  136.   line: string;
  137. begin
  138.   Result := New(PStringCollection, Init(5, 5));
  139.  
  140.   Assign(inf, FN);
  141.   Reset(inf);
  142.  
  143.   while not EOF(inf) do
  144.   begin
  145.     Readln(inf, line);
  146.     Result^.AtInsert(Result^.Count, NewStr(line));
  147.   end;
  148.  
  149.   Close(inf);
  150. end;
  151.  
  152. function SaveSeparatedList(FN, templateFN: FNameStr; mp3s: PCollection;
  153.   GetMP3Tag: TFNGetMP3Tag; twoItemsRec: TTwoItemsRec): Boolean;
  154. var
  155.   line: string;
  156.   f, inf: Text;
  157.   mc: PMacrosEngine;
  158.   totSize, totNum, subSize, subNum, i, j, k, temp: Longint;
  159.   coll, subColl: PCollection;
  160.   tag: PjID3v1;
  161.   mp3: Pmp3;
  162.   subFooter, subHeader, info: PStringCollection;
  163. begin
  164.  
  165.   Result := false;
  166.  
  167.   line := ExtractDir(ParamStr(0));
  168.   line := Copy(line, 1, Length(line) - 1);
  169.   ChDir(line);
  170.  
  171.   templateFN := FExpand(templateFN);
  172.  
  173.   totSize := 0;
  174.   totNum := 0;
  175.  
  176.   if (not ExistFile(ForceExtension(templateFN, 'hdr'))) or
  177.     (not ExistFile(ForceExtension(templateFN, 'inf'))) or
  178.     (not ExistFile(ForceExtension(templateFN, 'ftr'))) or
  179.     (not ExistFile(ForceExtension(templateFN, 'shd'))) or
  180.     (not ExistFile(ForceExtension(templateFN, 'sft'))) then
  181.   begin
  182.     MsgBox.MessageBox(#3'There are some template''s files missing.', nil,
  183.       mfError or mfOkButton);
  184.     Exit;
  185.   end;
  186.  
  187.   mc := New(PMacrosEngine, Init);
  188.   mc^.AddAdditionalMacros;
  189.   mc^.AddMacro('@version', Version, mcUser);
  190.   mc^.AddMacro('@longversion', Concat('MPEG Searcher (', Platform, ') v',
  191.     Version), mcUser);
  192.  
  193.   Assign(f, FN);
  194.   Rewrite(f);
  195.  
  196.   Assign(inf, ForceExtension(templateFN, 'hdr'));
  197.   Reset(inf);
  198.  
  199.   while not EOF(inf) do
  200.   begin
  201.     Readln(inf, line);
  202.     line := mc^.Process(line);
  203.     if not mc^.EmptyLine then
  204.       Writeln(f, line);
  205.   end;
  206.  
  207.   Close(inf);
  208.  
  209.   coll := PMP3Searcher(Application)^.MP3ListDialog^.SeparateAndSort(
  210.     twoItemsRec.firstFactor, twoItemsRec.secondFactor);
  211.  
  212.   subHeader := MakeCollectionFromFile(ForceExtension(templateFN, 'shd'));
  213.   subFooter := MakeCollectionFromFile(ForceExtension(templateFN, 'sft'));
  214.   info := MakeCollectionFromFile(ForceExtension(templateFN, 'inf'));
  215.  
  216.   for i := 0 to coll^.Count - 1 do
  217.   begin
  218.  
  219.     subColl := PCollection(coll^.Items^[i]);
  220.     mp3 := Pmp3(subColl^.Items^[0]);
  221.  
  222.     tag := GetMP3Tag(mp3^.Filename);
  223.  
  224.     MakeStandardMacros(tag, mc, temp, mp3^.Filename);
  225.  
  226.     FreeMem(tag, SizeOf(TjID3v1));
  227.  
  228.     for k := 0 to subHeader^.Count - 1 do
  229.     begin
  230.       if subHeader^.Items^[k] = nil then
  231.         line := ''
  232.       else
  233.         line := PString(subHeader^.Items^[k])^;
  234.       line := mc^.Process(line);
  235.       if not mc^.EmptyLine then
  236.         Writeln(f, line);
  237.     end;
  238.  
  239.     subSize := 0;
  240.     subNum := 0;
  241.  
  242.     for j := 0 to subColl^.Count - 1 do
  243.     begin
  244.       inc(totNum);
  245.  
  246.       mp3 := Pmp3(subColl^.Items^[j]);
  247.       tag := GetMP3Tag(mp3^.Filename);
  248.  
  249.       inc(subNum);
  250.       inc(subSize, tag^.Size);
  251.  
  252.       MakeStandardMacros(tag, mc, totSize, mp3^.Filename);
  253.  
  254.       for k := 0 to info^.Count - 1 do
  255.       begin
  256.         if info^.Items^[k] = nil then
  257.           line := ''
  258.         else
  259.           line := PString(info^.Items^[k])^;
  260.         line := mc^.Process(line);
  261.         if not mc^.EmptyLine then
  262.           Writeln(f, line);
  263.       end;
  264.  
  265.       FreeMem(tag, SizeOf(TjID3v1));
  266.     end;
  267.  
  268.     mc^.AddMacro('@subnum', Long2Str(subNum), mcUser);
  269.     mc^.AddMacro('@subsize', Long2Str(subSize), mcUser);
  270.  
  271.     for k := 0 to subFooter^.Count - 1 do
  272.     begin
  273.       if subFooter^.Items^[k] = nil then
  274.         line := ''
  275.       else
  276.         line := PString(subFooter^.Items^[k])^;
  277.       line := mc^.Process(line);
  278.       if not mc^.EmptyLine then
  279.         Writeln(f, line);
  280.     end;
  281.  
  282.   end;
  283.  
  284.   mc^.AddMacro('@totsize', Long2Str(totSize), mcUser);
  285.   mc^.AddMacro('@totnum', Long2Str(totNum), mcUser);
  286.  
  287.   Assign(inf, ForceExtension(templateFN, 'ftr'));
  288.   Reset(inf);
  289.  
  290.   while not EOF(inf) do
  291.   begin
  292.     Readln(inf, line);
  293.     line := mc^.Process(line);
  294.     if not mc^.EmptyLine then
  295.       Writeln(f, line);
  296.   end;
  297.  
  298.   Close(inf);
  299.  
  300.   Dispose(subHeader, Done);
  301.   Dispose(subFooter, Done);
  302.   Dispose(info, Done);
  303.  
  304.   for i := 0 to coll^.Count - 1 do
  305.   begin
  306.     subColl := PCollection(coll^.Items^[i]);
  307.     for j := 0 to subColl^.Count - 1 do
  308.     begin
  309.       mp3s^.AtInsert(mp3s^.Count, subColl^.Items^[j]);
  310.     end;
  311.     subColl^.DeleteAll;
  312.   end;
  313.  
  314.   Dispose(coll, Done);
  315.   Dispose(mc, Done);
  316.   Close(f);
  317.  
  318.   Result := true;
  319.  
  320. end;
  321.  
  322. function SaveListWhole(FN, templateFN: FNameStr; mp3s: PCollection;
  323.   GetMP3Tag: TFNGetMP3Tag): Boolean;
  324. var
  325.   f, inf: Text;
  326.   tag: PjID3v1;
  327.   i, j: Integer;
  328.   line: string;
  329.   mc: PMacrosEngine;
  330.   infoBuffer: PStringCollection;
  331.   totSize, Size: Longint;
  332. begin
  333.  
  334.   Result := false;
  335.  
  336.   totSize := 0;
  337.   line := ExtractDir(ParamStr(0));
  338.   line := Copy(line, 1, Length(line) - 1);
  339.   ChDir(line);
  340.  
  341.   templateFN := FExpand(templateFN);
  342.  
  343.   if (not ExistFile(ForceExtension(templateFN, 'hdr'))) or
  344.     (not ExistFile(ForceExtension(templateFN, 'inf'))) or
  345.     (not ExistFile(ForceExtension(templateFN, 'ftr'))) then
  346.   begin
  347.     MsgBox.MessageBox(#3'There are some template''s files missing.', nil,
  348.       mfError or mfOkButton);
  349.     Exit;
  350.   end;
  351.  
  352.   Assign(f, FN);
  353.   Rewrite(f);
  354.  
  355.   mc := New(PMacrosEngine, Init);
  356.   mc^.AddAdditionalMacros;
  357.   mc^.AddMacro('@version', Version, mcUser);
  358.   mc^.AddMacro('@longversion', Concat('MPEG Searcher (', Platform, ') v',
  359.     Version), mcUser);
  360.  
  361.   Assign(inf, ForceExtension(templateFN, 'hdr'));
  362.   Reset(inf);
  363.  
  364.   while not EOF(inf) do
  365.   begin
  366.     Readln(inf, line);
  367.     line := mc^.Process(line);
  368.     if not mc^.EmptyLine then
  369.       Writeln(f, line);
  370.   end;
  371.  
  372.   Close(inf);
  373.  
  374.   infoBuffer := New(PStringCollection, Init(10, 10));
  375.  
  376.   infoBuffer := MakeCollectionFromFile(ForceExtension(templateFN, 'inf'));
  377.  
  378.   for i := 0 to mp3s^.Count - 1 do
  379.   begin
  380.     tag := GetMP3Tag(Pmp3(mp3s^.Items^[i])^.Filename);
  381.  
  382.     MakeStandardMacros(tag, mc, totSize, Pmp3(mp3s^.Items^[i])^.Filename);
  383.  
  384.     for j := 0 to infoBuffer^.Count - 1 do
  385.     begin
  386.       if infoBuffer^.Items^[j] = nil then
  387.         line := ''
  388.       else
  389.         line := mc^.Process(PString(infoBuffer^.Items^[j])^);
  390.       if not mc^.EmptyLine then
  391.         Writeln(f, line);
  392.     end;
  393.  
  394.     FreeMem(tag, SizeOf(TjID3v1));
  395.  
  396.   end;
  397.  
  398.   mc^.AddMacro('@totsize', Long2Str(totSize), mcUser);
  399.   mc^.AddMacro('@totnum', Long2Str(mp3s^.Count), mcUser);
  400.  
  401.   Assign(inf, ForceExtension(templateFN, 'ftr'));
  402.   Reset(inf);
  403.  
  404.   while not EOF(inf) do
  405.   begin
  406.     Readln(inf, line);
  407.     line := mc^.Process(line);
  408.     if not mc^.EmptyLine then
  409.       Writeln(f, line);
  410.   end;
  411.  
  412.   Close(inf);
  413.  
  414.   Dispose(infoBuffer, Done);
  415.   Dispose(mc, Done);
  416.  
  417.   Close(f);
  418.  
  419.   Result := true;
  420.  
  421. end;
  422.  
  423. function SaveFilesBBS(const FN: FNameStr; mp3s: PCollection;
  424.   GetMP3Tag: TFNGetMP3Tag): Boolean;
  425. var
  426.   F: PBufStream;
  427.   i: Integer;
  428.   line: string;
  429.   tag: PjID3v1;
  430. begin
  431.   Result := false;
  432.   F := New(PBufStream, Init(FN, stCreate, 2048));
  433.  
  434.   if F^.Status <> stOk then
  435.   begin
  436.     MsgBox.MessageBox(#3'Unable to create' + #13#10#3 + ShrinkPath(FN, 33),
  437.       nil, mfError or mfOkButton);
  438.     Dispose(F, Done);
  439.     Exit;
  440.   end;
  441.  
  442.   for i := 0 to mp3s^.Count - 1 do
  443.   begin
  444.     line := Pmp3(mp3s^.Items^[i])^.Filename;
  445.     tag := GetMP3Tag(line);
  446.  
  447.     if Length(tag^.Songname) = 0 then
  448.       tag^.Songname := '?';
  449.     if Length(tag^.Artist) = 0 then
  450.       tag^.Artist := '?';
  451.     if Length(tag^.Album) = 0 then
  452.       tag^.Album := '?';
  453.  
  454.     line := ExtractFilename(line) + ExtractFileExt(line);
  455.  
  456.     if (Length(tag^.Artist) <> 0) and (Length(tag^.Songname) <> 0) then
  457.     begin
  458.  
  459.       line := line + ' ' + tag^.Artist + ' - ' + tag^.Songname;
  460.  
  461.     end;
  462.  
  463.     F^.Write(line[1], Length(line));
  464.     line := #13#10;
  465.     F^.Write(line[1], Length(line));
  466.   end;
  467.  
  468.   Dispose(F, Done);
  469.   Result := true;
  470. end;
  471.  
  472. function SaveM3U(const FN: FNameStr; mp3s: PCollection;
  473.   GetMP3Tag: TFNGetMP3Tag): Boolean;
  474. var
  475.   F: PBufStream;
  476.   i: Integer;
  477.   line: string;
  478. begin
  479.   Result := false;
  480.   F := New(PBufStream, Init(FN, stCreate, 2048));
  481.  
  482.   if F^.Status <> stOk then
  483.   begin
  484.     MsgBox.MessageBox(#3'Unable to create' + #13#10#3 + ShrinkPath(FN, 33),
  485.       nil, mfError or mfOkButton);
  486.     Dispose(F, Done);
  487.     Exit;
  488.   end;
  489.  
  490.   for i := 0 to mp3s^.Count - 1 do
  491.   begin
  492.     line := Pmp3(mp3s^.Items^[i])^.Filename;
  493.     F^.Write(line[1], Length(line));
  494.     line := #13#10;
  495.     F^.Write(line[1], Length(line));
  496.   end;
  497.  
  498.   Dispose(F, Done);
  499.   Result := true;
  500. end;
  501.  
  502. end.
  503.