Ir al contenido


Foto

[TRUCO DELPHI] Unidad para Archivos MP3.


  • Por favor identifícate para responder
No hay respuestas en este tema

#1 sir.dev.a.lot

sir.dev.a.lot

    Advanced Member

  • Miembros
  • PipPipPip
  • 545 mensajes
  • Location127.0.0.1

Escrito 10 diciembre 2016 - 04:14

[TRUCO DELPHI] Unidad para Archivos MP3.


delphi
  1. Unit uMP3Object;
  2.  
  3. interface
  4.  
  5. Uses
  6. Classes;
  7.  
  8. Const
  9. fmReadOnly = $00;
  10. fmWriteOnly = $01;
  11. fmReadWrite = $02;
  12. fmDenyAll = $10;
  13. fmDenyWrite = $20;
  14. fmDenyRead = $30;
  15. fmDenyNone = $40;
  16. fmNoInherit = $70;
  17.  
  18. Type
  19. TMp3Object = Class(TComponent)
  20. private
  21. FMp3File : String;
  22. FMp3FileShort : String;
  23. FVersion : Byte;
  24. FLayer : Byte;
  25. FBitrate : Byte;
  26. FSampfreq : Byte;
  27. FMode : Byte;
  28. FTagsongname : String;
  29. FTagArtist : String;
  30. FTagAlbum : String;
  31. FTagYear : String;
  32. FTagComment : String;
  33. FTagGenre : Integer;
  34. FTime : Integer;
  35. FTimeString : String;
  36. FSize : Integer;
  37. FSizeString : String;
  38. FmpegTypeString : String;
  39. FlayerString : String;
  40. FbitrateString : String;
  41. FSampleRateString : String;
  42. FChannelModeString: String;
  43.  
  44. procedure SetMp3File(Const Value : String);
  45. public
  46. property Mp3File : String read FMp3File write SetMp3File;
  47. property Mp3FileShort : String read FMp3FileShort;
  48. property Size : String read FSizeString;
  49. property BitRate : String read FBitRateString;
  50. property Time : String read FTimeString;
  51. end;
  52.  
  53. implementation
  54.  
  55. Uses
  56. Forms,
  57. SysUtils;
  58.  
  59. Type
  60. TStoreObject = Class(TComponent)
  61. private
  62. FMp3FileShort : String;
  63. FSize : String;
  64. FBitRate : String;
  65. FTime : String;
  66. public
  67. property Mp3FileShort : String read FMp3FileShort write FMp3FileShort;
  68. property Size : String read FSize write FSize;
  69. property BitRate : String read FBitRate write FBitRate;
  70. property Time : String read FTime write FTime;
  71. end;
  72.  
  73. TBuffer = Class(TComponent)
  74. private
  75. FStoreList : TStringList;
  76. public
  77. constructor Create(aOwner: Tcomponent); override;
  78. destructor Destroy; override;
  79.  
  80. function GetStoreObject(aFileName: String): TStoreObject;
  81. procedure SetStoreObject(aFileName: String; aStoreObject: TStoreObject);
  82. end;
  83.  
  84. Var
  85. theBuffer : TBuffer;
  86.  
  87. { Mp3Object }
  88.  
  89. Const
  90. cBG=0;
  91. cMODE_NAMES : Array[cBG+0..cBG+4] Of String[9]=('stereo','j-stereo','dual-ch','single-ch','multi-ch');
  92. cLAYER_NAMES : Array[cBG+0..cBG+2] Of String[3]=('i', 'II', 'III');
  93. cVERSION_NAMES: Array[cBG+0..cBG+2] Of String[10]=('MPEG-1','MPEG-2 LSF','MPEG-2.5');
  94. cVERSION_NUMS : Array[cBG+0..cBG+2] Of String[3]=('1','2','2.5');
  95. cBITRATES : Array [cBG+0..cBG+2] Of Array[cBG+0..cBG+2] Of Array[cBG+0..cBG+14] Of Word =
  96. {Mpeg 1} {Layer I} (((0,32,64,96,128,160,192,224,256,288,320,352,384,416,448),
  97. {Layer II} (0,32,48,56,64,80,96,112,128,160,192,224,256,320,384),
  98. {Layer III} (0,32,40,48,56,64,80,96,112,128,160,192,224,256,320)),
  99.  
  100. {Mpeg-2 Lsf}{Layer I} ((0,32,48,56,64,80,96,112,128,144,160,176,192,224,256),
  101. {Layer II} (0, 8,16,24,32,40,48, 56, 64, 80, 96,112,128,144,160),
  102. {Layer III} (0, 8,16,24,32,40,48, 56, 64, 80, 96,112,128,144,160)),
  103.  
  104. {Mpeg-2.5} {Layer I} ((0,32,48,56,64,80,96,112,128,144,160,176,192,224,256),
  105. {Layer II} (0,8,16,24,32,40,48,56,64,80,96,112,128,144,160),
  106. {Layer III} (0,8,16,24,32,40,48,56,64,80,96,112,128,144,160)));
  107. cSFREQ : Array[cBG+0..cBG+2] Of Array[cBG+0..cBG+3] Of Word =
  108. {mpeg 1} ((44100,48000,32000,0),
  109. {Mpeg-2 Lsf} (22050,24000,16000,0),
  110. {Mpeg-2.5} (11025, 8000, 8000,0));
  111.  
  112. Type
  113. buf = Array[0..4] Of Byte;
  114. taginfo = record
  115. id : Array[1.. 3] Of Char;
  116. Songname: Array[1..30] Of Char;
  117. Artist : Array[1..30] Of Char;
  118. Album : Array[1..30] Of Char;
  119. Year : Array[1.. 4] Of Char;
  120. Comment : Array[1..30] Of Char;
  121. Genre : Byte;
  122. end;
  123.  
  124. function IsBitSet(Var INByte: Byte; Bit2Test: Byte): Boolean;
  125. begin
  126. If (Bit2Test in [0..7]) Then
  127. Result := ((INByte And (1 Shl Bit2Test)) <> 0)
  128. Else
  129. Result := False;
  130. end;
  131.  
  132. function LeadingZero(w: Word): String;
  133. Var
  134. s : String;
  135. begin
  136. Str(w:0, s);
  137. If Length(s) = 1 Then
  138. s := '0' + s;
  139. LeadingZero := s;
  140. end;
  141.  
  142. procedure TMp3Object.SetMp3File(Const Value: String);
  143. Var
  144. buffer : buf;
  145. tag : taginfo;
  146. f : File;
  147. z,
  148. Result : Integer;
  149. diri : TSearchRec;
  150. myStoreObject : TStoreObject;
  151. begin
  152. FMp3File := Uppercase(Value);
  153. MyStoreObject := thebuffer.getStoreObject(FMp3File);
  154. If Assigned(MyStoreObject) Then
  155. begin
  156. FMp3FileShort := MyStoreObject.FMp3FileShort;
  157. FSizeString := MyStoreObject.FSize;
  158. FbitrateString:= MyStoreObject.FBitRate;
  159. FTimeString := MyStoreObject.FTime;
  160. Exit;
  161. end;
  162.  
  163. If FindFirst(Value, faAnyFile, diri) <> 0 Then
  164. Abort;
  165. FMp3FileShort := Diri.Name;
  166.  
  167. FSize := diri.Size;
  168. FSizeString := IntToStr(Diri.size);
  169. FileMode := fmReadonly + fmDenyNone;
  170. System.Assign(f, Value);
  171. System.Reset(f, 1);
  172.  
  173. z := 0;
  174. Result := SizeOf(buffer);
  175. buffer[0] := 0;
  176.  
  177. While (z < 20480) And
  178. (buffer[0] <> 255) And
  179. (Result = SizeOf(buffer)) Do
  180. begin
  181. Seek(f, z);
  182. Inc(z);
  183. System.BlockRead(f, buffer, SizeOf(buffer), Result);
  184. end;
  185.  
  186. System.Seek(f, FileSize(f) - 128);
  187. System.BlockRead(f, tag, SizeOf(tag));
  188. System.Close(f);
  189. {$I+}
  190. If IOResult <> 0 Then;
  191. If buffer[0] <> 255 Then
  192. begin
  193. FTimeString :='';
  194. FmpegTypeString :='';
  195. FLayerString :='';
  196. FbitrateString :='';
  197. FSampleRateString :='';
  198. FChannelModeString :='';
  199. end
  200. Else
  201. begin
  202. Flayer := 0;
  203. If isbitset(buffer[1], 1) Then Flayer := 1;
  204. If isbitset(buffer[1], 2) Then Flayer := Flayer + 2;
  205. Flayer := 4 - Flayer;
  206. Fbitrate := 0;
  207. If isbitset(buffer[2], 4) Then Fbitrate := 1;
  208. If isbitset(buffer[2], 5) Then Fbitrate := Fbitrate + 2;
  209. If isbitset(buffer[2], 6) Then Fbitrate := Fbitrate + 4;
  210. If isbitset(buffer[2], 7) Then Fbitrate := Fbitrate + 8;
  211. Fsampfreq := 0;
  212. If isbitset(buffer[2], 2) Then Fsampfreq :=1;
  213. If isbitset(buffer[2], 3) Then Fsampfreq := Fsampfreq + 2;
  214. Fversion := 0;
  215. If isbitset(buffer[1], 2) Then Fversion := 1;
  216. If isbitset(buffer[1], 3) Then Fversion := Fversion + 2;
  217. Case Fversion Of
  218. 2 : Fversion :=0;
  219. 3 : Fversion :=1;
  220. 0 : Fversion :=2;
  221. Else Fversion :=4;
  222. end;
  223.  
  224. Fmode :=0;
  225. If isbitset(buffer[3],6) Then
  226. Fmode := 1;
  227. If isbitset(buffer[3],7) Then
  228. Fmode := Fmode + 2;
  229. If cBITRATES[Fversion][Flayer - 1][Fbitrate] <> 0 Then
  230. begin
  231. Ftime := Fsize Div (cBITRATES[Fversion][Flayer - 1][Fbitrate]*125);
  232. FTimeString := IntToStr(Ftime Div 60) + ' : ' + leadingzero(Ftime Mod 60);
  233. end
  234. Else
  235. FTimeString :='';
  236.  
  237. FmpegTypeString := cVERSION_NAMES[Fversion];
  238. FlayerString := cLAYER_NAMES[Flayer - 1];
  239. FbitrateString := IntToStr(cBITRATES[Fversion][Flayer - 1][Fbitrate]);
  240. FSampleRateString := IntToStr(cSFREQ[Fversion][Fsampfreq]);
  241. FChannelModeString:= cMODE_NAMES[Fmode];
  242. end;
  243. If tag.id <> 'TAG' Then
  244. begin
  245. FTagsongname:= '';
  246. FTagArtist := '';
  247. FTagAlbum := '';
  248. FTagYear := '';
  249. FTagComment := '';;
  250. FTaggenre := 80;
  251. end
  252. Else
  253. begin
  254. FTagsongname:= TrimRight(tag.Songname);
  255. FTagArtist := TrimRight(tag.Artist);
  256. FTagAlbum := TrimRight(tag.Album);
  257. FTagYear := TrimRight(tag.Year);
  258. FTagComment := TrimRight(tag.Comment);
  259. FTaggenre := tag.genre;
  260. If Ftaggenre > 80 Then
  261. Ftaggenre := 80;
  262. end;
  263.  
  264. myStoreObject :=TStoreObject.Create(TheBuffer);
  265. MyStoreObject.FMp3FileShort := FMp3FileShort;
  266. MyStoreObject.FSize := FSizeString;
  267. MyStoreObject.FBitRate := FbitrateString;
  268. MyStoreObject.FTime := FTimeString;
  269. thebuffer.SetStoreObject(FMp3File, MyStoreObject);
  270. end;
  271.  
  272. { TBuffer }
  273.  
  274. constructor TBuffer.Create(aOwner: Tcomponent);
  275. begin
  276. inherited;
  277. //---
  278. FStoreList := TStringList.Create;
  279. FStoreList.Sorted := True;
  280. end;
  281.  
  282. destructor TBuffer.Destroy;
  283. Var
  284. i : Integer;
  285. begin
  286. For i := 0 To (FStoreList.Count - 1) Do
  287. FStoreList.Objects[i].Free;
  288. FStoreList.Free;
  289. //---
  290. inherited;
  291. end;
  292.  
  293. function TBuffer.GetStoreObject(aFileName: String): TStoreObject;
  294. Var
  295. idx : Integer;
  296. begin
  297. If FStoreList.Find(aFileName, idx) Then
  298. Result := TStoreObject(FStoreList.Objects[idx])
  299. Else
  300. Result := Nil;
  301. end;
  302.  
  303. procedure TBuffer.SetStoreObject(aFileName: String; aStoreObject: TStoreObject);
  304. begin
  305. FStoreList.AddObject(aFileName, aStoreObject);
  306. end;
  307.  
  308. initialization
  309. TheBuffer := TBuffer.Create(Application);
  310. finalization
  311. TheBuffer.Free;
  312. end.

Saludos!


  • 1




IP.Board spam blocked by CleanTalk.