Solved

delphi InternetOpenUrl makes my app hang

Posted on 2009-05-18
5
2,044 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 500 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

What Should I Do With This Threat Intelligence?

Are you wondering if you actually need threat intelligence? The answer is yes. We explain the basics for creating useful threat intelligence.

Join & Write a Comment

The uses clause is one of those things that just tends to grow and grow. Most of the time this is in the main form, as it's from this form that all others are called. If you have a big application (including many forms), the uses clause in the in…
Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
In this seventh video of the Xpdf series, we discuss and demonstrate the PDFfonts utility, which lists all the fonts used in a PDF file. It does this via a command line interface, making it suitable for use in programs, scripts, batch files — any pl…
This demo shows you how to set up the containerized NetScaler CPX with NetScaler Management and Analytics System in a non-routable Mesos/Marathon environment for use with Micro-Services applications.

706 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

Need Help in Real-Time?

Connect with top rated Experts

17 Experts available now in Live!

Get 1:1 Help Now