Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Работа с сетью в Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 24.12.2016, 20:33   #1
NetSpace
Участник клуба
 
Аватар для NetSpace
 
Регистрация: 03.06.2009
Сообщений: 1,792
По умолчанию заморочка Synaps и HTML

Ну вот и я до сюда дополз... Задача вот в чём: с сайта погоды снимаются данные и отображаются в небольшом окне или в любом другом компоненте, способном отображать текст. Данные эти выуживаются из HTML-кода. Искать по коду - для меня это не проблема.
1. Работающая программа была реализована при помощи стандартного компонента WebBrowser. Но она слишком тяжела из-за визуального компонента. Пока отложил её в сторону.
2. При помощи невизуальных средств Synsps обращаюсь к тому же сайту в надежде получить код. Библиотеки ssl_openssl и httpsend, DLL libeay32.dll и ssleay32.dll тоже нашёл и в папку с проектом кинул. Перебрав множество вариантов, что есть на форумах и сайтах, нашёл более-менее рабочий перемусоленный код, который хоть что-то да возвращает:
Код:
procedure TForm1.Button1Click(Sender: TObject);
var data:TStringStream;
    http:thttpsend;
begin
   Memo1.Clear;
   http:= THTTPSend.Create;
   data:=TStringStream.Create('');
   http.Document.Clear;
   http.Cookies.Clear;
   http.TargetHost:='www.gismeteo.ru';
   http.Protocol:='1.1';
   http.UserAgent:='Mozilla/5.0 (Windows NT 6.1; WOW64; rv:37.0) Gecko/20100101 Firefox/37.0';
   http.MimeType:='Content-Type: application/x-www-form-urlencoded; charset=UTF-8 X-Requested-With: XMLHttpRequest';
   http.KeepAlive:=true;
   http.Headers.Add('Referer: https://www.gismeteo.ru');
   http.Headers.Add('Accept-Language: ru-RU,ru;q=0.8,en-US;q=0.5,en;q=0.3');
   http.Headers.Add('Accept-Encoding: gzip, deflate');
   data.WriteString('submit=test');
   http.Timeout:=1000;
   http.Document.LoadFromStream(data);
   http.HTTPMethod('GET','https://www.gismeteo.ru/city/legacy/3970/');
   Memo1.Lines.AddStrings(http.Headers);
   //Memo1.Lines.LoadFromStream(http.Document);
   http.Clear;
   http.Free;
   data.Free;
end;
а вот и ответ:
Код:
HTTP/1.1 301 Moved Permanently
Server: openresty/1.9.15.1
Date: Sat, 24 Dec 2016 17:31:08 GMT
Content-Type: text/html; charset=UTF-8
Transfer-Encoding: chunked
Connection: keep-alive
Set-Cookie: new=1; Expires=Sun, 24-Dec-17 17:31:08 GMT; Domain=.www.gismeteo.ru; Path=/; Secure
X-Powered-By: PHP/7.0.13
Cache-Control: no-store, no-cache, must-revalidate, post-check=0, pre-check=0
Expires: Sat, 26 Jul 1997 05:00:00 GMT
Location: /weather-pechora-3970/
Strict-Transport-Security: max-age=-1
1 вопрос: по этому способу с сайтом связь есть? ну, в смысле ответ?
2 вопрос: и как возможно получить HTML код страницы?
3 вопрос: есть ли ещё невизуальные 'лёгкие' компоненты, дыбы извлечь код страницы по ссылке? (Indy не предлагать)
Программирование - это единственный способ заставить компьютер делать то, что тебе хочется, а не то, что приходится.

Последний раз редактировалось NetSpace; 24.12.2016 в 22:09.
NetSpace вне форума Ответить с цитированием
Старый 24.12.2016, 22:49   #2
NetSpace
Участник клуба
 
Аватар для NetSpace
 
Регистрация: 03.06.2009
Сообщений: 1,792
По умолчанию

АДМИН! разобрался. решение тут лежит http://asd-soft.ru/delphi-wininet-begin-http/
удаляй безвозвратно этот пост.
Программирование - это единственный способ заставить компьютер делать то, что тебе хочется, а не то, что приходится.
NetSpace вне форума Ответить с цитированием
Старый 25.12.2016, 02:49   #3
Alex11223
Старожил
 
Аватар для Alex11223
 
Регистрация: 12.01.2011
Сообщений: 19,500
По умолчанию

Зачем?оО

И тут нельзя безвозвратно.
Ушел с форума, https://www.programmersforum.rocks, alex.pantec@gmail.com, https://github.com/AlexP11223
ЛС отключены Аларом.
Alex11223 вне форума Ответить с цитированием
Старый 25.12.2016, 10:43   #4
NetSpace
Участник клуба
 
Аватар для NetSpace
 
Регистрация: 03.06.2009
Сообщений: 1,792
По умолчанию

да просто нет смысла тут держать пост, если никто не ответил и никто не воспользовался решением проблемы
Программирование - это единственный способ заставить компьютер делать то, что тебе хочется, а не то, что приходится.
NetSpace вне форума Ответить с цитированием
Старый 25.12.2016, 13:39   #5
Alex11223
Старожил
 
Аватар для Alex11223
 
Регистрация: 12.01.2011
Сообщений: 19,500
По умолчанию

Так вы ж вроде бы дали ссылку на решение.
Ушел с форума, https://www.programmersforum.rocks, alex.pantec@gmail.com, https://github.com/AlexP11223
ЛС отключены Аларом.
Alex11223 вне форума Ответить с цитированием
Старый 25.12.2016, 14:30   #6
NetSpace
Участник клуба
 
Аватар для NetSpace
 
Регистрация: 03.06.2009
Сообщений: 1,792
По умолчанию

дак я на неё вообще СЛУЧАЙНО наткнулся, перебрав 25-27 сайтов, где выложены неработающие при определённых обстоятельствах на сегодняшний день варианты. а кто-то вообще плюнет после 3-го неудачного варианта. и всё, имеем разочарованного несостоявшегося юного программиста. потери в наших рядах пока не нужны.
1. вобщем, вот кому надо архив и код. сделал по-минимуму, урезав все лишние функции и библиотеки. висит внизу в свёрнутом виде и показывает в заголовке температуру на сегодня и немного на завтра. решил сделать, чтоб постоянно не вылазить на сайт погоды, в связи с участившимися актировками (до -47 доходило...). мелочь, а приятно видеть! при желании, можно подставить свой город в коде (выделено красным)
2. далее думаю сделать по аналогии чтоб баланс мой и траффик (использую USB-модем) выводило. а то за этими цифрами тоже надо на сайт вылазить. бывает, смотришь вечерком интересное видео и бац! - смс с уведомлением, мол денюжку подкиньте, а то 'сАвсем-сАвсем тихо будет'.
ну, как-то так
Код:
program GisMeteo;
{$R dialog.res}

function SetTimer(hWnd:LongWord;nIDEvent,uElapse:LongWord;lpTimerFunc:Pointer):LongWord;stdcall;external 'user32.dll' name 'SetTimer';
function KillTimer(hWnd:LongWord;uIDEvent:LongWord):LongBool;stdcall;external 'user32.dll' name 'KillTimer';
function InternetOpen(lpszAgent:PAnsiChar;dwAccessType:LongWord;lpszProxy,lpszProxyBypass:PAnsiChar;dwFlags:LongWord):Pointer;stdcall;external 'wininet.dll' name 'InternetOpenA';
function InternetConnect(hInet:Pointer;lpszServerName:PChar;nServerPort:Word;lpszUsername:PChar;lpszPassword:PChar;dwService:LongWord;dwFlags:LongWord;dwContext:LongWord):Pointer;stdcall;external 'wininet.dll' name 'InternetConnectA';
function HttpOpenRequest(hConnect:Pointer;lpszVerb:PChar;lpszObjectName:PChar;lpszVersion:PChar;lpszReferrer:PChar;lplpszAcceptTypes:PAnsiChar;dwFlags:LongWord;dwContext:LongWord):Pointer;stdcall;external 'wininet.dll' name 'HttpOpenRequestA';
function HttpSendRequest(hRequest:Pointer;lpszHeaders:PChar;dwHeadersLength:LongWord;lpOptional:Pointer;dwOptionalLength:LongWord):LongBool;stdcall;external 'wininet.dll' name 'HttpSendRequestA';
function HttpQueryInfo(hRequest:Pointer;dwInfoLevel:LongWord;lpvBuffer:Pointer;var lpdwBufferLength:LongWord;var lpdwReserved:LongWord):LongBool;stdcall;external 'wininet.dll' name 'HttpQueryInfoA';
function InternetReadFile(hFile:Pointer;lpBuffer:Pointer;dwNumberOfBytesToRead:LongWord;var lpdwNumberOfBytesRead:LongWord):LongBool;stdcall;external 'wininet.dll' name 'InternetReadFile';
function InternetCloseHandle(hInet:Pointer):LongBool;stdcall;external 'wininet.dll' name 'InternetCloseHandle';
procedure PostQuitMessage(nExitCode:Integer);stdcall;external 'user32.dll' name 'PostQuitMessage';
function SendMessage(hWnd:LongWord;Msg:LongWord;wParam:LongInt;lParam:LongInt):LongInt;stdcall;external 'user32.dll' name 'SendMessageA';
function SetWindowText(hWnd:LongWord;lpString:PAnsiChar):LongBool;stdcall;external 'user32.dll' name 'SetWindowTextA';
function DialogBoxParam(hInstance:LongWord;lpTemplateName:PChar;hWndParent:LongWord;lpDialogFunc:Pointer;dwInitParam:LongInt):Integer;stdcall;external 'user32.dll' name 'DialogBoxParamA';
function DialogBox(hInstance:LongWord;lpTemplate:PChar;hWndParent:LongWord;lpDialogFunc:Pointer):Integer;
begin
   Result:=DialogBoxParam(hInstance,lpTemplate,hWndParent,lpDialogFunc,0);
end;
//----- глобальные константы и переменные --------------------------------------
var Handle:LongWord;
    hInet,hCon,hReq:Pointer;
    Status,StatusSize,Index:LongWord;
    bytes,b,ps:Cardinal;
    a,c:Byte;
    tst,rst:string;

//----- функция обработки сообщений --------------------------------------------
function DlgProc(wnd:LongWord;msg:integer;wparam:LongInt;lparam:LongInt):LongInt;stdcall;
begin
   case msg of
   3: SendMessage(wnd,$0112,61472,0);
   $0110:
   begin
      SetTimer(wnd,1,60000,nil);
   end;
   $0113:
   begin
      //SetWindowText(wnd,'загрузка');
      bytes:=1;
      hInet:=InternetOpen('My Agent',0,nil,nil,0);
      hCon:=InternetConnect(hInet,'gismeteo.ru',80,nil,nil,3,0,0);
      hReq:=HttpOpenRequest(hCon,'GET','city/legacy/3970','HTTP/1.0',nil,nil,$00400000 or $80000000,0);
      HttpSendRequest(hReq,'',0,nil,0);
      StatusSize:=SizeOf(Status);
      Index:=0;
      HttpQueryInfo(hReq,$20000000 or 19,@Status,StatusSize,Index);
      ps:=1;
      b:=1;
      rst:='';
      while(b>0)do
      begin
         SetLength(rst,Cardinal(Length(rst))+bytes);
         InternetReadFile(hReq,@rst[Ps],bytes,b);
         Inc(Ps,b);
      end;
      InternetCloseHandle(hReq);
      InternetCloseHandle(hCon);
      InternetCloseHandle(hInet);
      tst:='';
      Delete(rst,1,Pos('MG.Media.ad_top.start',rst)-1);
      Delete(rst,Pos('new adfox',rst),Length(rst)-Pos('new adfox',rst));
      a:=1;
      c:=0;
      while(a=1)do//and(c<8)do
      begin
         if(Pos('data-air=',rst)=0)then a:=0;
         if(Pos('data-air=',rst)<>0)then
         begin
            inc(c);
            Delete(rst,1,Pos('data-air=',rst)+Length('data-air='));
            if(c mod 2=1)then tst:=tst+Copy(rst,1,Pos('"',rst)-1)+#176+#32;
         end;
      end;
      Delete(tst,Length(tst),1);
      SetWindowText(wnd,PChar(tst));
   end;
   $0002,$0010:
   begin
      KillTimer(Handle,1);
      PostQuitMessage(0);
      Result:=0;
      Exit;
   end;
   end;
   Result:=0;
end;

begin
   DialogBox(hInstance,'MAIN_WINDOW',0,@DlgProc);
end.
Изображения
Тип файла: jpg gis.JPG (2.2 Кб, 122 просмотров)
Вложения
Тип файла: rar GisMeteo.rar (17.2 Кб, 22 просмотров)
Программирование - это единственный способ заставить компьютер делать то, что тебе хочется, а не то, что приходится.

Последний раз редактировалось NetSpace; 25.12.2016 в 14:33.
NetSpace вне форума Ответить с цитированием
Старый 26.12.2016, 23:36   #7
Aliens_wolfs
Форумчанин
 
Регистрация: 16.12.2009
Сообщений: 902
По умолчанию

На Synaps тоже все работает
попробуй обнови файлы libeay32.dll, ssleay32.dll
от сюда https://drive.google.com/file/d/0B0P...czRzJtbWM/view
Ссылка взята от сюда http://www.programmersforum.ru/showt...=301619&page=3 пост #23

Последний раз редактировалось Aliens_wolfs; 26.12.2016 в 23:42.
Aliens_wolfs вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Synaps + cookie Alex2009 Работа с сетью в Delphi 1 08.02.2013 17:39
Заморочка с where Dexes SQL, базы данных 5 08.02.2012 17:17
Заморочка с ZedGraph sputnick Общие вопросы .NET 1 13.09.2010 09:42
интерестная заморочка!;) АС Плюшкин Помощь студентам 3 29.10.2007 12:09