Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2010.01.10;
Скачать: CL | DM;

Вниз

Чтение файла по HTTP с помощью wininet.   Найти похожие ветки 

 
d@nger   (2008-05-13 13:40) [0]

Здравствуйте! В своей программе реализовал проверку выхода новой версии программы. На сайте выложил текстовый файл с номером новой версии, который считывает программа и сравнивает с текущей версией и сообщает пользователю результат. Реализовал я это с помощью модуля wininet, и все вроде как работает, НО есть маленькая проблемка. Для проверки я делаю следующее. Запускаю программу и проверяю наличие новой версии...программа говорит что есть. Тогда выключаю интернет соединение и проверяю еще раз.... программа запомнив последний ответ выдает мне его снова, хотя я предусмотрел ответ на отсутствие интернет соединения. Тогда я закрываю программу и открываю снова...теперь программа отвечает правильно...то же самое происходит и на оборот... в конце процедуры я закрываю сессию...почему так происходит, никак не могу взять в толк... подскажите что не так... (код постом ниже)...


 
d@nger   (2008-05-13 13:41) [1]


function TFmain.OpenInternet(Name: WideString): pointer;
begin
 result:=InternetOpen(@Name[1],INTERNET_OPEN_TYPE_PRECONFIG,nil, nil, 0);
end;

function Tfmain.Connect(hInternet : pointer): pointer;
begin
 result:=nil;
 if hInternet=nil  then exit;
 result:=InternetConnect(hInternet, "credcalc.narod.ru", INTERNET_DEFAULT_HTTP_PORT,
   "anonymous", nil, INTERNET_SERVICE_HTTP, 0, 0);
end;

function Tfmain.NewRequest(fURL : WideString; hConnect: pointer): pointer;
begin
 result := nil;
 if hConnect = nil then exit;
 result := HTTPopenRequestW(hConnect, nil, @fURL[1], nil, nil, nil,
                           INTERNET_FLAG_PRAGMA_NOCACHE or INTERNET_FLAG_RELOAD, 0);
end;

function tfmain.SendRequest(hRequest: pointer): boolean;
begin
 result := false;
 if hRequest = nil then exit;
 result := HTTPsendRequestW(hRequest,nil, 0, nil, 0);
end;

function tfmain.DataAvailable(hRequest: pointer; out Size : cardinal): boolean;
begin
 result := wininet.InternetQueryDataAvailable(hRequest, Size, 0, 0);
end;

function HttpQueryInfoW(hRequest: HINTERNET; dwInfoLevel: DWORD;
 lpvBuffer: Pointer; var lpdwBufferLength: DWORD;
 lpdwReserved: pointer): BOOL; stdcall;
           external "wininet.dll" name "HttpQueryInfoW";

function tfmain.SizeQuery(hRequest: pointer; out Size:cardinal):boolean;
var RSize:cardinal;
begin
 RSize:=4;
 result := HttpQueryInfoW(hRequest, HTTP_QUERY_CONTENT_LENGTH or HTTP_QUERY_FLAG_NUMBER,
                  @Size,RSize, nil);
 if not result then Size:=0;
end;

procedure tfmain.CloseURL(hURL : pointer);
begin
 InternetCloseHandle(hURL);
end;

function tfmain.ReadURL(fURL : WideString; var openresurs:boolean): WideString;
var hInternet,hConnect,hRequest:pointer;
   I,L,Size,ReadedSize:cardinal;
   B:boolean;
   Buff:ANSIString;
begin
 result:="";
 openresurs:=true;
//  fpleasewait.Panel1.Caption:="";
 hInternet:=OpenInternet("CredCalc Update");
 if not assigned(hinternet) then begin openresurs:=false; exit;end;
 hConnect:=Connect(hInternet);
 if not assigned(hConnect) then begin openresurs:=false; exit;end;
 hRequest:=NewRequest(furl, hConnect);
 if not assigned(hrequest) then begin openresurs:=false; exit;end;
 openresurs:=SendRequest(hRequest);
 if NOT openresurs then
 begin
  if hRequest<>nil then CloseURL(hRequest);
  if hConnect<>nil then CloseURL(hConnect);
  if hInternet<>nil then CloseURL(hInternet);
  exit;
 end;

 SizeQuery(hRequest, Size);
 inc(Size);
 SetLength(Buff, Size);
 B:=false;
 I:=1;

 while true do
 begin
   DataAvailable(hRequest, L);
   if L = 0 then break;
   if (I + L) > Size then SetLength(Buff, I + L);
   B := wininet.InternetReadFile(hRequest, @Buff[I], L, ReadedSize);
   if NOT B then break;
   inc(I, ReadedSize);
 end;

 Buff[I]:=#0;
 showmessage("ded");
 CloseURL(hRequest);
 CloseURL(hConnect);
 CloseURL(hInternet);
 {$Ifdef FILE_DEBUG_OUTPUT}
 SetFile("tmp.txt", "error");
 {$ENDIF}
 if B then
 begin
   result := WideString(Buff);
   {$Ifdef FILE_DEBUG_OUTPUT}
   SetFile("tmp.txt", result);
   {$ENDIF}
 end else result:="";
end;


 
piople ©   (2008-05-15 05:08) [2]

А что мешает перед попыткой проверить файл отправить Ping твоего сервера? Если все норм то ты проверяешь файл, в противном случае - "Невозможно соедениться с сервером".


 
Slym ©   (2008-05-15 05:23) [3]

piople ©   (15.05.08 5:08) [2]
тупиковый ход: HTTPProxy, SOCKS, freecap - через них пинг может не проканать, это раз.... Два это: хост не обязан отвечать на пинги, но может поддерживать HTTP сервер


 
Slym ©   (2008-05-15 05:26) [4]

я понимаю что процедурный язык, что ООП всякие, но зачем так часто и не по месту? Оформи все в одну функцию (даже не в метод), закрывай все хендлы в конце проседуры... может и заработает как надо


 
piople ©   (2008-05-15 05:30) [5]


> HTTPProxy, SOCKS, freecap

Исходник посмотрите и увидите что поддерждку прокси он все равно не реализовывал


>  Два это: хост не обязан отвечать на пинги

Опять же в сырцах он коннектится на "credcalc.narod.ru" он пингуется )


 
TForumHelp ©   (2008-05-25 15:32) [6]

попробуй так

function GetInetFile(fileURL, FileName: String): boolean;
const BufferSize = 1024;
var
 hSession, hURL: HInternet;
 Buffer: array[1..BufferSize] of Byte;
 BufferLen: DWORD;
 f: File;
 sAppName: string;
begin
Result:=False;
hSession := InternetOpen(PChar("IE"),
               INTERNET_OPEN_TYPE_PRECONFIG,
              nil, nil, 0);
try
 hURL := InternetOpenURL(hSession,
           PChar(fileURL),
           nil,0,0,0);
 try
  AssignFile(f, FileName);
  Rewrite(f,1);
  repeat
   InternetReadFile(hURL, @Buffer,
                    SizeOf(Buffer), BufferLen);
   BlockWrite(f, Buffer, BufferLen)
  until BufferLen = 0;
  CloseFile(f);
  Result:=True;
 finally
  InternetCloseHandle(hURL)
 end
finally
 InternetCloseHandle(hSession)
end
end;

function CheckInetUrlExist(url: string): boolean;
var
 NetHandle: HINTERNET;
 UrlHandle: HINTERNET;
begin
 Result := False;
 NetHandle := InternetOpen(PChar("IE"), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
 if Assigned(NetHandle) then begin
 UrlHandle := InternetOpenUrl(NetHandle, PChar(Url), nil, 0, INTERNET_FLAG_RELOAD, 0);
 if Assigned(UrlHandle) then begin
 Result := True;
 End;
 End;
 InternetCloseHandle(NetHandle);
 InternetCloseHandle(UrlHandle);
end;



Страницы: 1 вся ветка

Текущий архив: 2010.01.10;
Скачать: CL | DM;

Наверх




Память: 0.49 MB
Время: 0.012 c
1-1232544933
bartalbi
2009-01-21 16:35
2010.01.10
Выезжающие панели


8-1202287090
alex870
2008-02-06 11:38
2010.01.10
Скриншот содержимого Mediaplayer a


10-1162211576
Max Ivanych
2006-10-30 15:32
2010.01.10
Защита диапазона ячеек в Excel


3-1232787769
zorik
2009-01-24 12:02
2010.01.10
как в Firebird узнать количество дней в месяце?


4-1226015472
Eraser
2008-11-07 02:51
2010.01.10
Проверка подлинности сервера