no way to check internet connection state or time limit internet functions

[kvrichardson]

Hi -
I'm trying to do a quick FTP send of a small file to my website from my program (installed, of course, on my clients machine).

I only want the program to do the send if it can be done quickly. Not being connected to the internet results in long delays with Wininet functions which Microsoft confirms at http://support.microsoft.com/support/kb/articles/Q176/4/20.ASP

An easy way to solve this problem would be to quickly test if the computer is connected to the internet before InternetConnect / FtpPutFile calls (i.e. skip them if not connected). Unfortunately, the three API's designed to do this, to the best of my knowledge and thru my own testing, don't work.

1. exi=InternetGetConnectedState(ivb, iv) returns .true. if the computer is connected to a network, even if it isn't connected to the internet itself.

2. EXI=InternetCheckConnection ('http://www.microsoft.com', 0,0) returns .false. no matter what - a search of Google wininet newsgroup confirmed that it doesn't work for others as well.

3. ditto for retint=InternetAttemptConnect(0) - returned .false. every time regardless if I was connected to internet or not. Plus it is designed to launch a connection dialog which I don't want.

A fourth alternative would be to execute a ping command from my program and redirect output to file, then ensure "loss = 0" is found in text file. Unfortunately I can get "ping 68.100.16.25 >pinglog.txt" to work at the DOS prompt but not if launched from within my program...probably something to do with my Winteracter "IosCommand" command line executor not recognizing it has to wait for responses to pings. If anyone has a way to do this, my problem is solved (providing I can get the ping command to execute fairly quickly by using one of the options listed at ping /?, such as the -n option).

Finding no other method, I tried using InternetSetOption INTERNET_OPTION_CONNECT_TIMEOUT to limit the connect time and InternetSetOption INTERNET_OPTION_SEND_TIMEOUT on the FtpPutFile but they had no effect.

So I researched it and there is a bug described at the MSDN link above - says the only way to get timeout to work is with Asynchronous setting (or start a separate thread, which I have no idea how to implement). SO I set up my subroutine (an adaptation of wininet.f90) for synchronous FTP transfer using the guidelines in Platform SDK - three steps are required:

1. do the call to InternetOpen with INTERNET_FLAG_ASYNC flag
2. register callback to receive all status information regarding internet session
3. pass a non-zero value for context in all calls (usually the last variable
passed for internetconnect, ftpput, etc.

See code below.

But I am having two problems and would appreciate any help.
1. my callback is called numerous times during internetconnect (this is the one that causes the biggest delays - takes a long time to return to program if no internet connection found) but in my callback routine I cannot access any of the variables to test what the status is

2. the internetconnect function fails every time (returns 0 with getlasterror saying I/O Pending) even with a minute given for internet timeout.
How can I get it to succeed in asyn chronous mode so my next command, FTPPUTFILE command, can work?

I was thinking I could loop until a. the callback returned status complete or b. the time ran out.

But since I cannot access status in my callback, that won't work.

In any case I need a valid handle returned to do the putfile command.
I must be doing something wrong. I've followed the format in Wininet.f90 for the callback.

The code works fine if I use normal synchronous mode - it's been working great when there is an internet connection.

Thanks,

Keith Richardson
AMS

subroutine send_custom_dat(hwnd,kvr)
!sends custom.dat to website
use WinInet
use kernel32, only : GetLastError
use dfwinty, only : GENERIC_WRITE, NULL_CHARACTER, NULL
use dfwin, only: MessageBox, MB_OK

interface
subroutine myinitcallback(hInternet, dwContext, dwInternetStatus, &
lpvStatusInformation, dwStatusInformationLength)
!dec$ attributes stdcall :: InternetCallback
integer :: hInternet, dwInternetStatus, dwStatusInformationLength
integer(int_ptr_kind()) :: dwContext, lpvStatusInformation
!dec$ attributes value :: hInternet, dwContext, dwInternetStatus
!dec$ attributes value :: lpvStatusInformation, dwStatusInformationLength
end subroutine myinitcallback
end interface

integer :: hInternetSession, hHttpConnect, hHttpOpenRequest
integer :: hFtpConnect, hFtpFile, nFtpBytesWritten
integer :: lBufferLength, lBytesREAD !,winhan
integer iError, iv, ivb, retint,hwnd,error_code, icontext
integer*2 iv2
! real rv1, startsec
character (len=1024) :: sBuffer
character cv24*24,cv13*13, cbuff*100
logical exi, bret, kvr

integer, parameter :: InternetFlags = INTERNET_FLAG_KEEP_CONNECTION + &
INTERNET_FLAG_RESYNCHRONIZE + &
INTERNET_FLAG_RELOAD + &
INTERNET_FLAG_IGNORE_REDIRECT_TO_HTTPS + &
INTERNET_FLAG_IGNORE_REDIRECT_TO_HTTP

character(len=*), parameter :: scUserAgent = "xxxxx"C
character(len=*), parameter :: salutation = "Log File "C

character(len=*), parameter :: ftphostname ="xxxxx.com"C !"YourFTPserver.com"C
character(len=*), parameter :: ftpuserid ="xxxxx"C !"YourFtpUserID"C
character(len=*), parameter :: ftppassword ="xxxxx"C !"YourFtpPassword"C
external myinitcallback

nullify(NULL_CHARACTER)

icontext=9382
hInternetSession=0; hHttpConnect=0; hHttpOpenRequest=0
hFtpConnect=0; hFtpFile=0; nFtpBytesWritten=0
sBuffer=" "; lBufferLength=len(sBuffer); lBytesREAD=0; iError=0; bRet=.true.

!see if alREADy connected to internet
iv=0
ivb=0
exi=InternetGetConnectedState(ivb, iv)
if (.not.exi) then
return !only tells if a connection must be made
endif

!initialize wininet functions - use same session settings for Http and Ftp
hInternetSession = InternetOpen(scUserAgent,INTERNET_OPEN_TYPE_PRECONFIG, &
NULL_CHARACTER, NULL_CHARACTER, INTERNET_FLAG_ASYNC )

if (hInternetSession == 0) then
return
endif

retint=InternetSetStatusCallback(hInternetSession,myinitcallback)

!set timeout to 500 ms = .5sec
iv=4000 !1000 = 1 second
ivb=4
retint=InternetSetOption(hInternetSession,INTERNET_OP TION_CONNECT_TIMEOUT,loc(iv),ivb)

!set number of retries at 2 not default of 5
iv=2
ivb=4
retint=InternetSetOption(hInternetSession,INTERNET_OPTION_CONNECT_RETRIES,loc(iv),ivb)

! rv1=0
! startsec = SECNDS (rv1)
hFtpConnect = InternetConnect(hInternetSession, ftphostname, int(INTERNET_DEFAULT_FTP_PORT, &
kind=INTERNET_PORT), ftpuserid, ftppassword, INTERNET_SERVICE_FTP,INTERNET_FLAG_PASSIVE, icontext)

if (hFtpConnect == 0) then
if(kvr) then
error_code=GETLASTERROR()
if(error_code.eq.ERROR_INTERNET_EXTENDED_ERROR) then
ivb=100
cbuff=' '
retint=InternetGetLastResponseInfo(iv,cbuff,ivb)
else
CALL GET_ERROR_CODE_TEXT(2,error_code,cbuff)
endif
retint = MessageBox (hwnd, CBUFF,"CUTPLAN.EXE CONNECT FAILURE"C,MB_OK)
endif
goto 20
endif

!set timeout to 500 ms = .5sec
iv=1000 !1000 = 1 second
ivb=4
retint=InternetSetOption(hInternetSession,INTERNET_OPTION_SEND_TIMEOUT,loc(iv),ivb)

bret=FtpPutFile(hFtpConnect,cv13,cv13,0,icontext)
if(.not.bret) then
if(kvr) then
error_code=GETLASTERROR()
CALL GET_ERROR_CODE_TEXT(2,error_code,cbuff)
IF (CBUFF(1:1).EQ.' ') CBUFF='FtpPutFile error message'
retint = MessageBox (hwnd, CBUFF,"CUTPLAN.EXE LAUNCH FAILURE"C,MB_OK)
endif
endif
50 bRet = InternetCloseHandle(hFtpConnect)
20 bRet = InternetCloseHandle(hInternetSession)

return
end
!****************************************************************
subroutine myinitcallback(hInternet, dwContext, dwInternetStatus, &
lpvStatusInformation, dwStatusInformationLength)
integer :: hInternet, dwInternetStatus, dwStatusInformationLength
integer(int_ptr_kind()) :: dwContext, lpvStatusInformation
CHARACTER CV1000*1000

! call GET_ERROR_CODE_TEXT(2,lpvStatusInformation,CV1000)
!
! OPEN (10,FILE='CALLBACK.LOG',STATUS='UNKNOWN',FORM='BINARY',ACCESS='APPEND')
! WRITE(10) CV1000
! CLOSE(10)

end subroutine myinitcallback

[Jugoslav_Dujic]

I played with your code a little. I'm not very familiar with Wininet (I used to play with it once and even tried to translate Wininet.h to Fortran, and I even have Wininet.f90 on my disk, but I forgot where I downloaded it from), but here are my findings:

1) Your prototype of myinitcallback was wrong (you didn't specify stdcall in implementation, only in interface)

2) Once you start asynchronous talking, all the info you receive will be through the callback. All calls to function will give an error and GetLastError gives ERROR_IO_PENDING. That's normal, but it means that you have to reorganize your code. Thus, I removed error handling (you should put it into the callback).

3) The code below talks to the server (it receives a logical series of INTERNET_STATUS messages, like "request sent", "response received" etc.). I didn't investigate them all, (I didn't manage to upload the file) -- use the callback below just as a template. Pay attention to INTERNET_ASYNC_RESULT structure and its dwError member.

(Disclaimer: it (kinda) works if I put a breakpoint before FtpPutFile to ensure the callback will be called before that, i.e. hFtpConnect will receive value. Didn't try "Run" at all, just watched through debugger).

idThread is just my sanity check, which failed -- thread of the main program and the callback is the same. I don't know what kind of magic is going on, i.e. from where is the callback actually called.

Hope this helps,
Jugoslav

=========================================
interface
subroutine myinitcallback(hInternet, dwContext, dwInternetStatus, &
lpvStatusInformation, dwStatusInformationLength)
!dec$ attributes stdcall :: myinitcallback
integer :: hInternet, dwInternetStatus, dwStatusInformationLength
integer(int_ptr_kind()) :: dwContext, lpvStatusInformation
end subroutine myinitcallback
end interface

integer :: hInternetSession, hHttpConnect, hHttpOpenRequest, iret
integer :: hFtpConnect, hFtpFile, nFtpBytesWritten
common/FTPCONN/ hFtpConnect
integer :: lBufferLength, lBytesREAD !,winhan
integer:: iError, iv, ivb, retint,hwnd,error_code, icontext, idThread
integer*2 iv2
! real rv1, startsec
character (len=1024) :: sBuffer
character cv24*24,cv13*13, cbuff*100
logical:: exi, bret, kvr=.true.

integer, parameter :: InternetFlags = INTERNET_FLAG_KEEP_CONNECTION + &
INTERNET_FLAG_RESYNCHRONIZE + &
INTERNET_FLAG_RELOAD + &
INTERNET_FLAG_IGNORE_REDIRECT_TO_HTTPS + &
INTERNET_FLAG_IGNORE_REDIRECT_TO_HTTP

character(len=*), parameter :: scUserAgent = "xxxxx"C
character(len=*), parameter :: salutation = "Log File "C

character(len=*), parameter :: ftphostname ="YourFTPserver.com"C
character(len=*), parameter :: ftpuserid ="YourFTPUserID"C
character(len=*), parameter :: ftppassword ="YourFTPPassword"C

nullify(NULL_CHARACTER)

hWnd = xWnd%hWnd
icontext=9382
hInternetSession=0; hHttpConnect=0; hHttpOpenRequest=0
hFtpConnect=0; hFtpFile=0; nFtpBytesWritten=0
sBuffer=" "; lBufferLength=len(sBuffer); lBytesREAD=0; iError=0; bRet=.true.

!see if alREADy connected to internet
iv=0
ivb=0
exi=InternetGetConnectedState(ivb, iv)
if (.not.exi) then
return !only tells if a connection must be made
endif

!initialize wininet functions - use same session settings for Http and Ftp
hInternetSession = InternetOpen(scUserAgent,I NTERNET_OPEN_TYPE_PRECONFIG, &
NULL_CHARACTER, NULL_CHARACTER, INTERNET_FLAG_ASYNC )

if (hInternetSession == 0) then
return
endif

retint=InternetSetStatusCallback(hInternetSession,myinitcallback)

!set timeout to 500 ms = .5sec
iv=4000 !1000 = 1 second
ivb=4
retint=InternetSetOption(hInternetSession,INTERNET_OPTION_CONNECT_TIMEOUT,loc(iv),ivb)

!set number of retries at 2 not default of 5
iv=2
ivb=4
retint=InternetSetOption(hInternetSession,INTERNET_OPTION_CONNECT_RETRIES,loc(iv),ivb)

! rv1=0
! startsec = SECNDS (rv1)
iret = InternetConnect(hInternetSession, ftphostname, int(INTERNET_DEFAULT_FTP_PORT, &
kind=INTERNET_PORT), ftpuserid, ftppassword, INTERNET_SERVICE_FTP,INTERNET_FLAG_PASSIVE, icontext)

idThread = GetCurrentThreadID()

!set timeout to 500 ms = .5sec
iv=1000 !1000 = 1 second
ivb=4
retint=InternetSetOption(hInternetSession,INTERNET_OPTION_SEND_TIMEOUT,loc(iv),ivb)

bret=FtpPutFile(hFtpConnect,"D:UsersDuja_Brisi.txt"C,"wwwbrisi.txt"C,INTERNET_FLAG_DONT_CACHE,icontext)

END SUBROUTINE XFrame_OnAbout
!****************************************************************
subroutine myinitcallback(hInternet, dwContext, dwInternetStatus, &
lpvStatusInformation, dwStatusInformationLength)
use wininet
!dec$ attributes stdcall :: myinitcallback

integer:: hFtpConnect, idThread
integer :: hInternet, dwInternetStatus, dwStatusInformationLength
integer(int_ptr_kind()) :: dwContext, lpvStatusInformation
type(INTERNET_ASYNC_RESULT):: IAR; POINTER(pIAR, IAR)
INTEGER:: iResponse; POINTER(pResponse, iResponse)
common/FTPCONN/ hFtpConnect

CHARACTER CV1000*1000

!call GET_ERROR_CODE_TEXT(2,lpvStatusInformation,CV1000)

idThread = GetCurrentThreadID()

select case (dwInternetStatus)
case(INTERNET_STATUS_HANDLE_CREATED)
pIAR = lpvStatusInformation
hFtpConnect = IAR%dwResult
case(INTERNET_STATUS_REQUEST_COMPLETE)
pIAR = lpvStatusInformation
case(INTERNET_STATUS_RESPONSE_RECEIVED)
pResponse = lpvStatusInformation
end select

end subroutine myinitcallback