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

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

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

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 26.01.2017, 09:24   #11
Ship_1
Форумчанин
 
Регистрация: 10.02.2014
Сообщений: 526
По умолчанию

Aliens_wolfs, у меня не работает. Ошибку, конечно, не выводит, но и не делает ничего больше.
Ship_1 вне форума Ответить с цитированием
Старый 26.01.2017, 09:45   #12
Aliens_wolfs
Форумчанин
 
Регистрация: 16.12.2009
Сообщений: 902
По умолчанию

У МЕНЯ РАБОТАЕТ. Ссылку дайте для теста по которой пытаетесь подключиться, возможно что то в ней

Последний раз редактировалось Aliens_wolfs; 26.01.2017 в 11:14.
Aliens_wolfs вне форума Ответить с цитированием
Старый 26.01.2017, 11:45   #13
Ship_1
Форумчанин
 
Регистрация: 10.02.2014
Сообщений: 526
По умолчанию

"И незачем так орать, я и в первый раз прекрасно слышал." ©
И если Вы посмотрите на текст перед и после когда в стартовой записи, то увидите, что на двух компьютерах из трёх у меня тоже работает. Если имеет смысл - повторюсь: совпадение или нет, но два компьютера, с которыми работает - с Win7, и не работает на WinXP. Причём, на втором компьютере с Win7 заработала скомпилированная на WinXP.
Ну а если Вы всё-таки хотите проверить саму ссылку - у меня не работает с любой гитхабовской (а, может, и любой https-ной, не проверял). И если совсем уж конкретный пример хотите - пожалуйста.
Ship_1 вне форума Ответить с цитированием
Старый 26.01.2017, 12:00   #14
Alex11223
Старожил
 
Аватар для Alex11223
 
Регистрация: 12.01.2011
Сообщений: 19,500
По умолчанию

А что вы с гитхабом делать пытаетесь?

У него API есть, обычно удобнее и надежнее работать через него.
https://developer.github.com/v3/

В простых случаях это тоже просто HTTP GET запрос + парсинг JSON (какой-нибудь библиотекой)

Например
https://api.github.com/repos/jmistx/...ork/Migrations
Ушел с форума, https://www.programmersforum.rocks, alex.pantec@gmail.com, https://github.com/AlexP11223
ЛС отключены Аларом.
Alex11223 вне форума Ответить с цитированием
Старый 26.01.2017, 12:13   #15
Ship_1
Форумчанин
 
Регистрация: 10.02.2014
Сообщений: 526
По умолчанию

Alex11223, спасибо, интересно. Отдельное - за пример! Результат в нём очень интересный. Но избыточный Я просто выдёргиваю список ссылок на файлы и скачиваю их. Это достаточно элементарно сделать и простой обработкой страницы по ссылке (если убрать само подключение к https гитхаба). А в D7 не знаете чем удобнее с JSON работать?
Но я запомню Вашу информацию - может, и пригодится когда-нибудь.
Ship_1 вне форума Ответить с цитированием
Старый 26.01.2017, 12:36   #16
Alex11223
Старожил
 
Аватар для Alex11223
 
Регистрация: 12.01.2011
Сообщений: 19,500
По умолчанию

Первая ссылка в гугле предлагает https://sourceforge.net/projects/lkjson

Ну или если только ссылки достать, то можно и просто Pos/Copy и т.п., явно не хуже парсинга HTML тем же способом + не изменится внезапно по желанию дизайнеров и верстальщиков гитхаба.
Ушел с форума, https://www.programmersforum.rocks, alex.pantec@gmail.com, https://github.com/AlexP11223
ЛС отключены Аларом.
Alex11223 вне форума Ответить с цитированием
Старый 26.01.2017, 12:51   #17
Aliens_wolfs
Форумчанин
 
Регистрация: 16.12.2009
Сообщений: 902
По умолчанию

Есть еще вот такой простой примерчик, через WebBrowser страницы обрабатывать, должен работать в любой ОС, конечно не совсем правильное решение но все же работает.

Код:
 uses MSHTML, ActiveX, OleCtrls, SHDocVw, ....

procedure WaitForBrowser(WB: TWebbrowser);
begin
  while (WB.ReadyState <> READYSTATE_COMPLETE)
    and not (Application.Terminated) do
  begin
    Application.ProcessMessages;
    Sleep(0);
  end;
end;

function WebBrowserExtractDoc(Url: String): String;
var
WebBrowser: TWebBrowser;
DocStream: TStringStream;
begin
WebBrowser:= TWebBrowser.Create(nil);
DocStream:= TStringStream.Create('');
try
   WebBrowser.ParentWindow:= Application.Handle;
   WebBrowser.Hide;
   WebBrowser.Navigate(Url);
   WaitforBrowser(WebBrowser);
   (WebBrowser.Document as IPersistStreamInit).Save(TStreamAdapter.Create(DocStream), false);
   DocStream.Position:= 0;
   with TStringList.Create do
   begin
   LoadFromStream(DocStream);
   Result:= Text;
   free;
   end;
finally
WebBrowser.free;
DocStream.free;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
memo1.Text:= WebBrowserExtractDoc('Ваша ссылка');
end;
А для Synaps сразу обнови файлы libeay32.dll, ssleay32.dll
можно от сюда https://drive.google.com/file/d/0B0P...czRzJtbWM/view
иначе не всегда работает

По поводу Wininet есть интересный код пост#6 в этой ссылке http://www.programmersforum.ru/showthread.php?t=302008

Последний раз редактировалось Aliens_wolfs; 27.01.2017 в 08:59.
Aliens_wolfs вне форума Ответить с цитированием
Старый 30.01.2017, 09:25   #18
Aliens_wolfs
Форумчанин
 
Регистрация: 16.12.2009
Сообщений: 902
По умолчанию

Попробуй этот пример WinInet в Windows XP
Код:
function GetSite(URL: String; ResponseStream: TStream): string;
//Параметры нашего заголовка с ним можете поэкспериментировать
const
 Accept = 'Accept: */*' + sLineBreak;
 ProxyConnection = 'Proxy-Connection: Keep-Alive' + sLineBreak;
 LNG = 'Accept-Language: ru' + sLineBreak;
 AGENT =
   'User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; ' +
   'Windows NT 5.1; SV1; .NET CLR 2.0.50727)' + sLineBreak;
var
URL_Base,URL_Page:String;
hInet,hCon,hReq:Pointer;
  Status, StatusSize, Index: DWORD;
  bytes, b, posi: Cardinal;
  ResponseString: AnsiString;
  SRequest: String;
  ContentLength: Dword;
  buf: pointer;
  size: Integer;
begin

  if pos('https://',URL)>0 then
  delete(URL,1,length('https://'))
  else
   if pos('http://',URL)>0 then
   delete(URL,1,length('http://'));

  URL_Base:=PChar(copy(URL,1,pos('/',URL)-1));
  URL_Page:=PChar(copy(URL,pos('/',URL)+1,length(URL)-pos('/',URL)));

 hInet:= InternetOpen('My Agent',INTERNET_OPEN_TYPE_PRECONFIG,nil,nil,0);
 if not Assigned(hInet) then
begin
Showmessage('Error: InternetOpen');
exit;
end;

// Не пугайтесь что порт всегда http 80, даже если будет https запрос то он будет перенаправлен в нужное 
// направление так как в HttpOpenRequest INTERNET_FLAG_KEEP_CONNECTION
 hCon:= InternetConnect(hInet, PChar(URL_Base), 80 , nil, nil, INTERNET_SERVICE_HTTP, 0, 0);
  if not Assigned(hCon) then
  begin
  Showmessage('Error: InternetConnect');
  exit;
   end;

  hReq:= HttpOpenRequest(hCon, 'GET',PAnsichar(URL_Page),'HTTP/1.0', nil,nil,INTERNET_FLAG_KEEP_CONNECTION, 0);
  if not Assigned(hReq) then
  begin
  Showmessage('Error: HttpOpenRequest');
  exit;
  end;

         //Заполняем наш заголовок
      HttpAddRequestHeaders(hReq, Accept,
        Length(Accept), HTTP_ADDREQ_FLAG_ADD);
      HttpAddRequestHeaders(hReq, ProxyConnection,
        Length(ProxyConnection), HTTP_ADDREQ_FLAG_ADD);
      HttpAddRequestHeaders(hReq, LNG,
        Length(LNG), HTTP_ADDREQ_FLAG_ADD);
      HttpAddRequestHeaders(hReq, AGENT,
        Length(AGENT), HTTP_ADDREQ_FLAG_ADD);

        // Проверяем наш заголовок
      StatusSize := 0;
      Index := 0;
      SRequest := '';
      HttpQueryInfo(hReq, HTTP_QUERY_RAW_HEADERS_CRLF or
        HTTP_QUERY_FLAG_REQUEST_HEADERS, @SRequest[1], StatusSize, Index);
      if StatusSize > 0 then
      begin
         SetLength(SRequest, StatusSize);
        HttpQueryInfo(hReq, HTTP_QUERY_RAW_HEADERS_CRLF or
          HTTP_QUERY_FLAG_REQUEST_HEADERS, @SRequest[1], StatusSize, Index);
      end;


  // Отправляем запрос
  if not (HttpSendRequest(hReq,'',0,nil,0)) then
  begin
  Showmessage('Error: HttpSendRequest');
  exit;
  end;

//Код ответа
          StatusSize := SizeOf(Status);
          Index := 0;
          HttpQueryInfo(hReq, HTTP_QUERY_FLAG_NUMBER or HTTP_QUERY_STATUS_CODE , @Status, StatusSize, Index);

  //Запрашиваем размер файла для закачки
        ContentLength := InternetSetFilePointer(hReq, 0, nil, FILE_END, 0);
        if ContentLength = DWORD(-1) then
          ContentLength := 0;

         posi := 1;
          b := 1;
          ResponseString := '';
          while b > 0 do
          if InternetQueryDataAvailable( hReq, bytes, 0, 0 ) then
          begin

         if Assigned(ResponseStream) then
          begin
          getmem(buf, bytes);
          InternetReadFile(hReq, buf, bytes, b);
          ResponseStream.Write(buf^, b);
          freemem(buf);
          end
          else
          begin
            SetLength(ResponseString, Length(ResponseString) + bytes );
            InternetReadFile(hReq, @ResponseString[Posi], bytes, b );
            Inc(Posi, b);
          end;
          end;

   InternetCloseHandle(hReq);
   InternetCloseHandle(hCon);
   InternetCloseHandle(hInet);
  Result:=ResponseString;
end;
Использовать так
Код:
//Скачать файл
procedure TForm1.Button2Click(Sender: TObject);
var
MemoryStream: TMemoryStream;
begin
MemoryStream:= TMemoryStream.Create;
memo1.Lines.Add(GetSite(AnsiToUtf8('ссылка на файл), MemoryStream));
MemoryStream.SaveToFile('F:\111.rar');
MemoryStream.Destroy;
end;

//Страницу в Memo
procedure TForm1.Button2Click(Sender: TObject);
begin
memo1.Lines.Add(GetSite(AnsiToUtf8('Ссылка на страницу https и http'), nil);
end;

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


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

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Странная ошибка при записи в XML Юрий+ Windows Forms 0 14.06.2016 08:30
Странная ошибка при удалении пункта popupmenu в рантайм frte Общие вопросы Delphi 2 09.12.2014 21:13
Странная ошибка при обработке строки Didim Помощь студентам 31 08.11.2011 16:35
Странная ошибка при работе с вводом значения (dev C++) Николай ПН Помощь студентам 2 21.06.2011 11:56
Странная ошибка при выполнении okolobaxa Общие вопросы Delphi 2 03.07.2007 00:47