Go Premium for a chance to win a PS4. Enter to Win

x
?
Solved

delphi InternetOpenUrl makes my app hang

Posted on 2009-05-18
5
Medium Priority
?
2,112 Views
Last Modified: 2013-11-23
Hi. I've been puzzling over this for a while now. I need to check if a url is valid and has a page, however, while this is processing, my application hangs. The GUI freezes. This can take much longer if the URL cant be reached.
I've using Delphi 2006 Pro on XP by the way.

I tried putting the routine into a thread to split it off and still not working properly if the url cant be reached.

Included is the thread code and example calling procedure to perform the process. Stick  couple of controls onto your form and try to use them while the url is being fetched. write_to_log can be whatever logging procedure you prefer. in this, you could stick a memo on the form and make write_to_log() do a memo.lines.add().

Try changing the url to something incorrect and see what happens.

Any feedback would be great.

Best regards,
kinnon_2000
// URLCheckThread.pas included in main unit
unit URLCheckThread;
interface
uses
  Classes {$IFDEF MSWINDOWS} , Windows {$ENDIF}, Wininet;
type
  TURLCheckThread = class(TThread)
  private
    thrfinished, thrreturned :Boolean;
    urlstring:String;
    procedure SetName;
  protected
    procedure Execute; override;
  public
    property finished: Boolean read thrfinished;
    property returned: Boolean read thrreturned;
    property url: String write urlstring;
  end;
implementation
{$IFDEF MSWINDOWS}
type
  TThreadNameInfo = record
    FType: LongWord;     // must be 0x1000
    FName: PChar;        // pointer to name (in user address space)
    FThreadID: LongWord; // thread ID (-1 indicates caller thread)
    FFlags: LongWord;    // reserved for future use, must be zero
  end;
{$ENDIF}
 
{ URLCheckThread }
 
Function CheckUrl(url:string):boolean;
var
hSession, hfile: hInternet;
dwindex,dwcodelen :dword;
dwcode:array[1..20] of char;
res : pchar;
begin
  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;
 
procedure TURLCheckThread.SetName;
{$IFDEF MSWINDOWS}
var
  ThreadNameInfo: TThreadNameInfo;
{$ENDIF}
begin
{$IFDEF MSWINDOWS}
  ThreadNameInfo.FType := $1000;
  ThreadNameInfo.FName := 'TurlCheckThrd';
  ThreadNameInfo.FThreadID := $FFFFFFFF;
  ThreadNameInfo.FFlags := 0;
  try
    RaiseException( $406D1388, 0, sizeof(ThreadNameInfo) div sizeof(LongWord), @ThreadNameInfo );
  except
  end;
{$ENDIF}
end;
 
procedure TURLCheckThread.Execute;
begin
  SetName;
  { Place thread code here }
  thrfinished:=false;
  thrreturned:=false;
  if urlstring<>'' then thrreturned:=checkurl(urlstring);
end;
end.
 
 
// test procedure in main unit
procedure testurl;
var NewThread: TURLCheckThread;
begin
 NewThread := TURLCheckThread.Create(True);
  NewThread.FreeOnTerminate := True;
  try
    NewThread.url:='http://www.google.com';
    while NewThread.finished=false do begin
      sleep(250);
      NewThread.Resume;
    end;
   if NewThread.returned=false then write_to_log('returned false') else write_to_log('returned true');
  except on EConvertError do
    begin
      NewThread.Free;
      write_to_log('thread error');
    end;
  end;
  NewThread.Free;
end

Open in new window

0
Comment
Question by:kinnon_2000
  • 3
  • 2
5 Comments
 
LVL 4

Accepted Solution

by:
irishbuddha earned 1500 total points
ID: 24436653
Try this instead
We originally used a very simliar funciton to yours, someone found it on http://www.patilan.com/Delphi/tips1.htm#tips_3

After running into some speed issues, we flipped over to this and it performs a lot faster ("instantaneous" in most cases). (originally found at http://www.cryer.co.uk/brian/delphi/wininet/example_isurlvalid.htm)



function IsUrlValid(const url: string): boolean;
var
  hInet: HINTERNET;
  hConnect: HINTERNET;
  infoBuffer: array [0..512] of char;
  dummy: DWORD;
  bufLen: DWORD;
  okay: LongBool;
  reply: String;
begin
  hInet := InternetOpen(PChar(application.title),
    INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY,nil,nil,0);
  hConnect := InternetOpenUrl(hInet,PChar(url),nil,0,
    INTERNET_FLAG_NO_UI,0);
  if not Assigned(hConnect) then
    result := false
  else
  begin
    //------------------------------
    // Create a request for the url.
    //------------------------------
    dummy := 0;
    bufLen := Length(infoBuffer);
    okay := HttpQueryInfo(hConnect,HTTP_QUERY_STATUS_CODE,
      @infoBuffer[0],bufLen,dummy);
    if not okay then
      // Probably working offline, or no internet connection.
      result := False
    else
    begin
      reply := infoBuffer;
      if reply = '200' then
        // File exists, all ok.
        result := True
      else if reply = '401' then
        // Not authorised. Assume page exists,
        // but we can't check it.
        result := True
      else if reply = '404' then
        // No such file.
        result := False
      else if reply = '500' then
        // Internal server error.
        result := False
      else
        // Shouldn't get here! It means there is
        // a status code left unhandled.
        result := False;
    end;
    InternetCloseHandle(hConnect);
  end;
  InternetCloseHandle(hInet);
end;

Open in new window

0
 

Author Comment

by:kinnon_2000
ID: 24453587
Hi, sorry for delayed reply. The routine is a bit better, however, still locks up the gui if no internet access is found. To resolve this, I've built the function into a tiny service which does the checking seporate to the main gui application, and writes an empty file to the program directory called connection_error. IF the main program detects this with file_exists, it take approprate action. Thanks again for your response.  
0
 

Author Comment

by:kinnon_2000
ID: 24453595
sorry, i meant the fileexists() function, not file_exists.

Regards,
kinnon_2000
0
 

Author Closing Comment

by:kinnon_2000
ID: 31582538
not quire a solution, but better than what i was using.
0
 
LVL 4

Expert Comment

by:irishbuddha
ID: 24454558
Sorry, didn't realize you were having issues with the connection check as well, most of our work has been related only to bad urls, which is what I took from the original question was the true issue.

Let me look around and see what we're doing differently in some other connection checks and see if there is anything we've found lately.
0

Featured Post

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

A lot of questions regard threads in Delphi.   One of the more specific questions is how to show progress of the thread.   Updating a progressbar from inside a thread is a mistake. A solution to this would be to send a synchronized message to the…
In this tutorial I will show you how to use the Windows Speech API in Delphi. I will only cover basic functions such as text to speech and controlling the speed of the speech. SAPI Installation First you need to install the SAPI type library, th…
Loops Section Overview
When cloud platforms entered the scene, users and companies jumped on board to take advantage of the many benefits, like the ability to work and connect with company information from various locations. What many didn't foresee was the increased risk…
Suggested Courses

876 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question