1:

TScan.Create(ListBox1.Items.Strings[0], ThreadEnded);					

1:

Sleep(1);					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Bass, ExtCtrls, ComCtrls, mmsystem, FileCtrl, _UAudioFileFAQ;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    ProgressBar1: TProgressBar;
    ListBox1: TListBox;
    Button3: TButton;
    Button4: TButton;
    Edit1: TEdit;
    Button5: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button4Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);

  private

    { Private-Deklarationen }
  public
    ThreadsRunning: Integer;
    ThreadHist: integer;
    Procedure FindFiles (aPath, aFindMask: String;
                          aWithSub: Boolean; aResult: tStrings);
    procedure ThreadEnded(Sender: TObject);

    { Public-Deklarationen }
  end;

type
  TScan = class(TThread)

  private
    Stringlist: TStringlist;
    aFile: TAudioFile;
    Channel: HMUSIC;
    Handle: THandle;
    file_path: string;
    FFTData_TEMP,FFTData_FINAL: array[1..4096] of single;
    procedure ScanFile;
    procedure working;
    procedure initialize;
  protected
    procedure Execute; override;
  public

    constructor Create(path: string; const AOnTerminate: TNotifyEvent);
  end;

var
  Form1: TForm1;
implementation

{$R *.dfm}

function OpenThread(dwDesiredAccess: DWord;
                    bInheritHandle: Bool;
                    dwThreadId: DWord): DWord; stdcall; external 'kernel32.dll';

function GetCurrentThreadId: Cardinal; stdcall; external 'kernel32.dll';

function SetThreadAffinityMaskByID(ID, AffinityMask: Cardinal): Boolean;
var
  Handle: THandle;
    const
  THREAD_TERMINATE                 = $0001;
  THREAD_SUSPEND_RESUME            = $0002;
  THREAD_GET_CONTEXT               = $0008;
  THREAD_SET_CONTEXT               = $0010;
  THREAD_SET_INFORMATION           = $0020;
  THREAD_QUERY_INFORMATION         = $0040;
  THREAD_SET_THREAD_TOKEN          = $0080;
  THREAD_IMPERSONATE               = $0100;
  THREAD_DIRECT_IMPERSONATION      = $0200;
  THREAD_SET_LIMITED_INFORMATION   = $0400;
  THREAD_QUERY_LIMITED_INFORMATION = $0800;
  THREAD_ALL_ACCESS                = STANDARD_RIGHTS_REQUIRED or SYNCHRONIZE or $03FF;
begin
  Result:=False;
  Handle:=OpenThread(THREAD_SET_INFORMATION or THREAD_QUERY_INFORMATION, False, ID);
  if Handle<>0 then begin
     Result:=SetThreadAffinityMask(Handle, AffinityMask)<>0;
     CloseHandle(Handle);
  end;
end;

constructor TScan.Create(path: string; const AOnTerminate: TNotifyEvent);
begin
  inherited Create(TRUE);
  file_path := path;
  OnTerminate := AOnTerminate;
  FreeOnTerminate := true;
  Priority        := tpNormal;
  Resume;
end;

procedure TScan.initialize; // alles was hier steht war vorher in der "ScanFile" funktion
begin
  Handle:=OpenThread($0020 or $0040, False, GetCurrentThreadId);
  BASS_Init(-1, 44100, 0, Handle, nil);
  Channel := BASS_StreamCreateFile(false, PChar(file_path),
               0, 0, BASS_SAMPLE_MONO and BASS_STREAM_DECODE);
  BASS_ChannelPlay(Channel, false);

  Stringlist := TStringList.Create;

  aFile := TAudioFile.Create;
  aFile.GetAudioData(file_path);
  Stringlist.Add(aFile.Dateiname);
  Stringlist.Add(aFile.Artist);
  StringList.Add(aFile.Titel);
  StringList.Add(aFile.Album);
  StringList.Add(aFile.Year);
  StringList.Add(aFile.Genre);
  StringList.Add(inttostr(aFile.Dauer));
  StringList.Add(inttostr(aFile.DateiGroesse));
  StringList.Add(inttostr(aFile.Bitrate));
  StringList.Add(booltostr(aFile.vbr));
end;

procedure TScan.Execute;
begin
    Synchronize(initialize);
    ScanFile;
    Synchronize(working);
end;

procedure TScan.working;
begin
  CloseHandle(Handle);
  Bass_Free;
  Stringlist.Free;
  aFile.Free;
end;

procedure TScan.ScanFile;
Var i, hz:integer;
  length: QWORD;
  count, inkrement: int64;
  sec: double;
  filedouble: integer;
begin


  //BASS_ChannelPlay(Channel, false);

  length := BASS_ChannelGetLength(Channel, BASS_POS_BYTE);
  sec := BASS_ChannelBytes2Seconds(Channel, length);
  count := 0;

  inkrement := round((length / sec) / 10); // alle 100ms in bytes umrechnen

  while count <= length do
  begin
    count := count + inkrement;      //alle 200 ms
    BASS_ChannelSetPosition(Channel, count, BASS_POS_BYTE);
    BASS_ChannelGetData(Channel, @FFTData_TEMP, BASS_DATA_FFT4096);
    for I := 1 to 4096 do // X beliebige Zahl, je nach benötigter Menge der Frequenzen
      FFTData_FINAL[I] := FFTDATA_FINAL[I] + FFTData_TEMP[I];
  end;

  for I := 1 to 4096 do
  begin
    Stringlist.Add(inttostr(FFTDATA_Final[I]));
  end;

  filedouble := 0;
  while FileExists('.\ScanMedia\'+aFile.Dateiname+'_'+aFile.Titel+'('+inttostr(filedouble)+')'+inttostr(GetCurrentThreadId)+'.txt') = true do
    filedouble := filedouble + 1;

  StringList.SavetoFile('.\ScanMedia\'+aFile.Dateiname+'_'+aFile.Titel+'('+inttostr(filedouble)+')'+inttostr(GetCurrentThreadId)+'.txt');

end;

procedure TForm1.ThreadEnded(Sender: TObject);
begin
  Memo1.Lines.Add(inttostr(ThreadHist));
  if ListBox1.Items.Count > 0 then // nächstes file, nächster thread
  begin
    TScan.Create(ListBox1.Items.Strings[0], ThreadEnded);
    ListBox1.Items.Delete(0);
    inc(ThreadHist);
  end;
end;

Procedure TForm1.FindFiles (aPath, aFindMask: String; aWithSub: Boolean; aResult: tStrings);
Var
  FindRec: tSearchRec;
Begin
  // Wenn die Stringliste nil ist oder aPath oder aFind nicht angegeben ist
  // dann raus
  If (aPath = '') or (aFindMask = '') or Not Assigned (aResult) Then
    Exit;

  // Wenn am Ende der Pfadangabe noch kein \ steht, dieses hinzufügen
  // (Oder die Funktion  IncludeTrailingPathDelimiter aus der Unit SysUtils.pas verwenden)
  If aPath[Length (aPath)] <> '\' Then
    aPath := aPath + '\';

  // Im aktuellen Verzeichnis nach der Datei suchen
  If FindFirst (aPath + aFindMask, faAnyFile, FindRec) = 0 Then
    Repeat
      If (FindRec.Name <> '.') and (FindRec.Name <> '..') Then
        // ...Ergebnis in die Stringlist einfügen
        aResult.Add (aPath + FindRec.Name);
    Until FindNext (FindRec) <> 0;

  FindClose (FindRec);

  // Wenn nicht in Unterverzeichnissen gesucht werden soll dann raus
  If Not aWithSub Then
    Exit;

  // In Unterverzeichnissen weiter suchen
  If FindFirst (aPath + '*.*', faAnyFile, FindRec) = 0 Then
    Repeat
      If (FindRec.Name <> '.') and (FindRec.Name <> '..') Then
        // Feststellen, ob es sich um ein Verzeichnis handelt
        If Boolean (FindRec.Attr and faDirectory) Then
          // Funktion erneut aufrufen, um Verzeichnis zu durchsuchen (Rekursion)
          FindFiles (aPath + FindRec.Name, aFindMask, aWithSub, aResult);
    Until FindNext (FindRec) <> 0;

   FindClose(FindRec);
End;

procedure TForm1.Button3Click(Sender: TObject);
begin
  FindFiles(Edit1.Text, '*.mp3', true, ListBox1.Items);
end;

procedure TForm1.Button4Click(Sender: TObject);
var
  dir: String;
begin
  dir:=Edit1.Text;
  if SelectDirectory('Bitte wähle den Ordner aus, den Sie durchsuchen möchten.'+#13+
                     'Sollten Sie den Arbeitsplatz durchsuchen wollen, geben Sie dies bitte manuel ein!', '', dir) then Edit1.Text:=dir;
end;

procedure TForm1.Button5Click(Sender: TObject);
var itemcount: integer;
begin
  itemcount := Listbox1.Items.Count;

  if itemcount = 0 then
    exit;

  SetThreadAffinityMaskByID(GetCurrentThreadId, 0);


    if (Listbox1.Items.Count > 0) then
    begin
      TScan.Create(Listbox1.Items.Strings[0], ThreadEnded);
      ListBox1.Items.Delete(0);
      Listbox1.Update;
      inc(ThreadHist);
    end;
    if (Listbox1.Items.Count > 0) then
    begin
      TScan.Create(Listbox1.Items.Strings[0], ThreadEnded);
      ListBox1.Items.Delete(0);
      Listbox1.Update;
      inc(ThreadHist);
    end;
    if (Listbox1.Items.Count > 0) then
    begin
      TScan.Create(Listbox1.Items.Strings[0], ThreadEnded);
      ListBox1.Items.Delete(0);
      Listbox1.Update;
      inc(ThreadHist);
    end;
    if (Listbox1.Items.Count > 0) then
    begin
      TScan.Create(Listbox1.Items.Strings[0], ThreadEnded);
      ListBox1.Items.Delete(0);
      Listbox1.Update;
      inc(ThreadHist);
    end;

end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  //Bass_Free;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  //BASS_Init(-1, 44100, 0, Application.Handle, nil);
  Memo1.Clear;
  ThreadHist := 0;
end;

end.