Сильно упрощенная версия (Слегка быстрее и намного надежнее)...
Основная идея та же самая : "толстые" нити но в малом количестве.
Код: Выделить всё
TLoadableFileThread = class(TThread)
private
AName, MSG: String;
fFileNames: TStringList;
AData : TMemoryStream;
FWork: Boolean;
procedure GetNext;
protected
procedure Execute; override;
public
Procedure SLog;
Procedure SyncLog(M:String);
Procedure SyncLoad;
Procedure Load;
constructor Create(FileNames: TStringList);
destructor Destroy; override;
end;
Procedure TLoadableFileThread.SLog;
begin
LSIForm.Memo3.Lines.Add(MSG);
end;
Procedure TLoadableFileThread.SyncLoad;
begin
Application.ProcessMessages;
OneDraw(AName,AData);
end;
Procedure TLoadableFileThread.Load;
var
F:Integer;
HTTPClient :TFPHttpClient;
begin
if (Pos('http://', LowerCase(AName)) > 0) or
(Pos('https://', LowerCase(AName)) > 0)
then begin
F := 2; //2 попытки прочитать, если нужно.
while F > 0 do begin
HTTPClient := TFPHttpClient.Create(nil);
AData := TMemoryStream.Create;
try
HTTPClient.Get(AName, AData);
AData.Position := 0; //!! Сброс позиции в потоке !!!
// (Без него ничего не работает )
F:=-1;
except
Sleep(20);
F:=F-1;
end ;
HTTPClient.Free;
end;
if F = 0 then FreeAndNil(AData);
Synchronize(SyncLoad);
AData.Free;
end
else
begin
AData:=nil;
if FileExists(Aname) then
begin
AData:=TMemoryStream.Create;
try
AData.LoadFromFile(AName);
AData.Position := 0;
except
FreeAndNil( AData)
end;
end;
Synchronize(SyncLoad);
AData.Free;
end
end;
Procedure TLoadableFileThread.SyncLog(M:String);
begin
MSG:=M;
Synchronize(Slog);
end;
constructor TLoadableFileThread.Create(FileNames: TStringList);
begin
inherited Create(True);
FreeOnTerminate := False;
AName := '';
fFileNames:=FileNames;
ind:=0;
FWork := False;
end;
destructor TLoadableFileThread.Destroy;
begin
FreeOnTerminate:=True;
if not Terminated then Terminate;
inherited Destroy;
tLoadders.Delete(tLoadders.IndexOf(Self));
//Для лучшего контроля завершения работы потока
end;
procedure TLoadableFileThread.GetNext;
begin
FWork := False;
If (fFileNames<>Nil) and
(fFileNames.Count >0 )
then begin
EnterCriticalSection(x);
AName:= fFileNames[0];
fFileNames.Delete(0);
FWork := fFileNames.Count>=0;
LeaveCriticalSection(x);
end else
begin
SyncLog(' Поток ' + IntToStr(ThreadID) + ' завершает работу');
FreeOnTerminate := True;
Terminate;
end;
end;
procedure TLoadableFileThread.Execute;
var
i: LongInt;
S:String;
FromInternet:Boolean;
begin
SyncLog('Запуск ...');
while not Terminated do begin
GetNext;
if FWork then Load else sleep(iThreadWaitTimeout);
end;
end;
А быстрее за счет уменьшения синхронизированного участка кода (по сути синхронизируется только непосредственно "внешняя обработка" в процедуре OneDraw ).
Еще добавил список потоков tLoadders удобная штука для контроля процесса загрузки (можно сделать прогресс бар ),аварийного завершения работы загрузчика, контроля завершения загрузки (так как элементы списка удаляются непосредственно в деструкторе никаких накладок быть не может ) и возможно своевременного уничтожения повисших нитей-потоков . (но там нужно хорошенько подумать как это можно сделать максимально надежно без ложного срабатывания если поток просто замедлился но не повис )
В принципе верно я уже неплохо оптимизировал однопоточный код так что он идет "ноздря к ноздре" к монгопоточному . 