Под крышей DOM-a моего...(Парсинг HTML и рядом с ним)

Вопросы программирования и использования среды Lazarus.

Модератор: Модераторы

Alex2013
долгожитель
Сообщения: 3230
Зарегистрирован: 03.04.2013 11:59:44

Сообщение Alex2013 »

Внезапно вылезла проблема : При проверке чекбокса в потоке, портился интерфейс формы (причем не всегда а только если при загрузке программа пытается выполнять скрипт с сервера, что немного увеличивало максимальный таймаут ) Разумеется, сделал дополнительный флаг и все заработало как надо но сам факт вызвал "ступор" типа "Холмс! Но как?!! ", как на интерфейс может влиять простая проверка состояния непонятно, что называется в упор ! :shock:
Зы
И вроде проблема появилась еще до добавления многопоточного режима, но просто проявилась чуть реже ... Скрипт с "эксплойтом" (точнее похоже просто просто иногда портит структуру jpg-а, возможно при попытке делать "прогрессивное" сжатие ) что-ли ? Кстати как проверять валидность данных картинки ? (то есть ситуации когда программа получила из потока данные нужного размера но с ошибкой структуры )
Alex2013
долгожитель
Сообщения: 3230
Зарегистрирован: 03.04.2013 11:59:44

Сообщение Alex2013 »

"Мелочь а приятно"
Парочка функций, для облегчения DOM-парсинга...
(есть стандартная функция FoundNode но она не поддерживает "точную адресацию" которая иногда заметно удобнее )

Код: Выделить всё

// Вспомогательная функция  (не UTF8 но в данном случае это не критично) 
Function Next1(Var SS:String;Ch:Char):String;
var i:Longint;
begin
Result:='';
  I:=Pos(Ch,SS);
  If i>0 then begin
   Result:= Copy (ss,1,i-1);
 delete(SS,1,i);
  end
end;
// Доступ к "дереву"  DOMNode
//Path -определяет путь по дереву ChildNodes
Function DeepNode(N:TDOMNode;Path:String):TDOMNode;
Var
C:Integer;
begin
If Path='' then Begin Result:=N; exit end else Result:=Nil;
If N=Nil then exit ;
Repeat
If N.ChildNodes<>nil then begin
C:=StrToInt(Next1(Path,'\'));
If C < N.ChildNodes.Count then ;
N:=N.ChildNodes[C];
end;
until Path='';
Result:=N;
end;
// Получить атрибут ноды
Function GetNodeAttr(N:TDOMNode;NItem:String):String;
begin
Result:='Nil';
if N.HasAttributes Then
Result:=N.Attributes.GetNamedItem(NItem).TextContent;
end;


Используется например так: S:=GetNodeAttr(DeepNode(nlist[i],'2\1\4\'),'src');
Alex2013
долгожитель
Сообщения: 3230
Зарегистрирован: 03.04.2013 11:59:44

Сообщение Alex2013 »

Не совсем в тему, но нашел простой и качественный пример загрузчика файлов из интернета .
(монгопоточную загрузку не поддерживает но есть докачка + свободно качает по https )
Прикрученный к программе смотрится примерно так.
Изображение

https://forum.lazarus.freepascal.org/in ... 89901.html
Download_Ex.zip
Зы
Интересно где нибудь что-то еще более продвинутое попадалось?
Alex2013
долгожитель
Сообщения: 3230
Зарегистрирован: 03.04.2013 11:59:44

Сообщение Alex2013 »

Полезная штуковина!
Проверка коннекта сетью ( Работает без таймаута что не только заметно меньше давит на нервы он и избавляет от многих коллизий )

Код: Выделить всё

const
 INTERNET_CONNECTION_MODEM      = 1;
 INTERNET_CONNECTION_LAN        = 2;
 INTERNET_CONNECTION_PROXY      = 4;
 INTERNET_CONNECTION_MODEM_BUSY = 8;

function InternetGetConnectedState(lpdwFlags: LPDWORD; dwReserved:DWORD):BOOL; stdcall; external 'wininet.dll' name 'InternetGetConnectedState';
function InetIsOffline(Flag: Integer): Boolean; stdcall; external 'URL.DLL';
function IsInternetConnected: Boolean;
var
 dwConnectionTypes: DWORD;
begin
 dwConnectionTypes := INTERNET_CONNECTION_MODEM or
                      INTERNET_CONNECTION_LAN or
                      INTERNET_CONNECTION_PROXY;
 Result := InternetGetConnectedState(@dwConnectionTypes, 0);
end;



Добавлено спустя 59 минут 18 секунд:
Еще есть такая штука ...

Код: Выделить всё

uses wininet;
function CheckUrl(url: string): boolean;
var
  hSession, hfile, hRequest: hInternet;
  dwindex, dwcodelen: dword;
  dwcode: array [1..20] of char;
  res: pchar;
begin
  if pos('http://', lowercase(url)) = 0 then
    url := 'http://'+url;
  Result := false;
  hSession := InternetOpen('InetURL:/1.0', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
  if assigned(hsession) then
  begin
    hfile := InternetOpenUrl(hsession, pchar(url), nil, 0, INTERNET_FLAG_RELOAD, 0);
    dwIndex := 0;
    dwCodeLen := 10;
    HttpQueryInfo(hfile, HTTP_QUERY_STATUS_CODE, @dwcode, dwcodeLen, dwIndex);
    res := pchar(@dwcode);
    result := (res = '200') or (res = '302');
    if assigned(hfile) then
      InternetCloseHandle(hfile);
    InternetCloseHandle(hsession);
  end;
end; 

... Но смысла в ней немного, потому что работает она ОЧЕНЬ медленно .
Ответить