Несмотря на все ловушки и проверки ошибки ввода вывода при чтении текста веб-станиц и картинок к ней из интернета всеравно могут сильно затормозить работу программы.
Идеи обхода проблемы:
1 Сравнительно быстрая проверка существования конкретного файла для конкретного URL перед основным чтением.
Результат :
Частично помогает избежать совсем уж тяжелых сбоев парсинга (например когда сеть по невнятным причинам выкатывает какую-нибудь "страницу-заглушку" ) но в то же время дополнительный тормоз даже при нормальном чтении .
2 Попытка читать данные "по байтам" то есть с контролем состояния при чтении каждого байта из потока
Результат :
Идея неплоха, но из за буферизации данных ОС нормально не работает .
3 Запускать каждую операцию чтения в отдельном потоке с самостоятельным отлеживанием таймаута.
Примечание:
Для ускорения загрузки галереи картинок это это приходится делать в лбом случае ( последовательное чтение их списка просто "вымораживает" программу ) но там это происходит чуть иначе.
Результат :
Заметное улучшение контролируемости процесса но в то же время возникновение проблемы "современности " данных ( "зависший" процесс может внезапно "откопаться из сугроба" и начать запись данных по давно "убитому" адресу в памяти ) и просто современного завершения "повисшего процесса".
(Попытки остановить и завершить процесс принудительно
Типа такого
- Код: Выделить всё
If (now-CTime)*10e4 >=OutTime then begin
LoadPicThread.Suspend;
While not LoadPicThread.Suspended do Application.ProcessMessages;;
LoadPicThread.Free;
Exit;
end;
приводит к тяжелым сбоям)
Конкретные вопросы:
1 Есть ли надежные и быстрые способы проверки сосуществования файла или страницы без их чтения?
Мои идеи поэтому поводу довольно ущербны:
- Код: Выделить всё
uses fphttpclient;
...
Var
ResponseCode:string;
Function TestURL_https(URL:String;Timeout,Attempts:Integer):Boolean;
Const httpclient: TFPHTTPClient=Nil;
var
RC,AT: integer;
S:string;
T:Byte;
Label L1;
begin
Result:=True;
At:=1;
httpclient := TFPHttpClient.Create(nil);
httpclient.IOTimeout:=Timeout;
try
SetProxy(httpclient,FSetup.ProxyEd.Text);
S:= httpclient.Options(Url);
except
Result:=False;
end;
RC:= httpclient.ResponseStatusCode;
ResponseStatusText := httpclient.ResponseStatusText ;
If httpclient.ResponseStatusText <>'OK' Then begin
ResponseStatusText :='Нет доступа';
Result:=False;
end;
httpclient.Free;
end;
if not Result and (at< Attempts ) then begin
AT:=AT+1; Goto L1;
end;
end;
и
с компонентом Инди (Indy10)
- Код: Выделить всё
uses
.. IdHTTP, IdSSLOpenSS,;
...
var
ResponseCode:String;
Function URLCheck(URL:String;Pause:Integer; At:Byte):Boolean;
Var A:Byte;
Label L1;
begin
ResponseCode:= -100;
A:=1;
L1:
try
result:=true;
//IdHTTP1.ConnectTimeout:=100;
//IdHTTP1.ReadTimeout:=50;
IdHTTP1.HTTPOptions := IdHTTP1.HTTPOptions + [hoNoProtocolErrorException];
IdHTTP1.Head(URL);
result := IdHTTP1.Response.ResponseCode = 200;
ResponseCode:=IdHTTP1.Response.ResponseCode;
except
result:=False;
end;
If A<AT Then begin
Sleep(Pause);AT:=AT+1;
Goto L1;
end;
end;
2 Имеет ли в принципе смысл делать "Чтение потока из сети по байтам"?
Как-то так:
- Код: Выделить всё
// HttpGetBinary2 старая самоделка на основе synapse
ms:=TMemoryStream.Create;
If HttpGetBinary2(URL,'80', ms) then
begin
ms.Seek(0, soFromBeginning);
Tmp:=MS.ReadByte;// Читаю только один байт
end ;
finally
Result:=False;
ms.Free;
end;
st.Free;
Как верно обустроить потоковое чтение данных при чтении ОДНОГО файла (нтмл кода или картинки ) из сети?
Мой временный "чит-код" выглядит довольно криво и не вызывает доверия даже у меня самого :
- Код: Выделить всё
Const
T_End:Boolean=True;
Var
ffIM: Timage;
CTime:TDateTime;
// поток LoadPicThread_3
Type
TLoadPicThread_3=Class(TThread)
private
protected
procedure Execute; override;
procedure Load;
procedure SLoad;
public
UPDATE :Boolean;
fIM: Timage;
fURL:String;
IsTO,IsInternet:Boolean;
constructor Create(CreateSuspended: boolean;URL:
String;Var Im: Timage);
end;
procedure TLoadPicThread_3.Load;
Var
B:TBitmap;
begin
try
B:=RE_NetLoadBMP_PHP(fURL);// "Обычное" чтение картинки .
if Not FreeOnTerminate then begin
if b.Modified then fIm.Picture.Bitmap.Assign(B);
fIm.Picture.Bitmap.Modified:=b.Modified;
end;
B.Free;
except
end;
end;
procedure TLoadPicThread_3.SLoad;
begin
IsInternet:= IsInternetConnected ;
end;
procedure TLoadPicThread_3.Execute;
begin
while (not Terminated) do
If UPDATE then begin
Synchronize(@SLoad);
if IsInternet then Load;
if not T_End then
T_End:=True;
UPDATE :=False;
FreeOnTerminate := True;
if IsTO Then fIm.Free;
Terminate;
end;
end;
constructor TLoadPicThread_3.Create(CreateSuspended: boolean;
URL:String;Var Im: Timage);
begin
UPDATE := False;
fIM:=im;
ffIM:=im;
fUrl:=Url;
T_End:= False;
FreeOnTerminate := False;
IsTO:=False;
inherited Create(CreateSuspended);
end;
Type
TWProc=Procedure (Im: Timage);
Var
WProc:TWProc;
Timer_NTT:TLoadPicThread_3;
CTime:TDateTime;
FOutTime:TDateTime;
procedure Tform1.Timer4Timer(Sender: TObject);
begin
Timer4.Enabled:=False;
if not T_End then begin
If (now-CTime)*10e4 >=FOutTime then begin
Timer_NTT.IsTO:=True;
WProc(Nil);
Exit;
end;
Timer4.Enabled:=True;
end else begin
WProc(ffIm);
ffIm.Free;
Timer_NTT.Terminate;
end;
end;
Сама функция чтения .
- Код: Выделить всё
Function Thread_RE_NetLoadBMP_PHP(URL:String;OutTime:TDateTime=1.0;
PWProc:Pointer=Nil;
H:integer=0;W:integer=0;
PHP:Boolean=false):TBitmap;
var
NTT:TLoadPicThread_3;
IM:TImage;
begin
Result:=nil;
If not T_End then exit;
IM:=TImage.Create(Nil);
If PWProc<> NIL then
begin
If FSetup.Timer4.Enabled then exit;
WProc:=TWProc( PWProc );
Timer_NTT:=TLoadPicThread_3.Create(True,{False} URL, Im);
Timer_NTT.Start;
CTime:=Now;Timer_NTT.UPDATE:=true;
FOutTime:=OutTime;
FSetup.Timer4.Enabled:=True;
Exit;
end;
NTT:=TLoadPicThread_3.Create(True,{False} URL, Im);
NTT.Start;
CTime:=Now;NTT.UPDATE:=true;
While not T_End do begin
If (now-CTime)*10e4 >=OutTime then begin
NTT.IsTO:=True;
Exit;
end else NTT.Resume;
Application.ProcessMessages;
end;
Result:=TBitmap.Create;
Result.Assign(Im.Picture.Bitmap);
NTT.Terminate;
IM.Free;
end;
У нее есть два режима
1 Простой "с ожиданием"
BB:=Thread_RE_NetLoadBMP_PHP(S);
2 С "отложенным чтением" ( с проверкой по таймеру )
- Код: Выделить всё
Procedure TestIMG (Im:TImage);far;
begin
...
If Im = Nil Then exit; // если таймаут
...
im.Free;
...
end;
...USetUp01.Thread_RE_NetLoadBMP_PHP(S,1.0,@TestIMG);
В общем понятно, что логика этой поделки малость хромает и есть множество возможностей "чему-то пойти не так", однако, пока лучше ничего не придумал .
