PROGRAM GETFILE  ! CVF compiler source, program gets internet file
IMPLICIT NONE    ! Compile:  >DF GETFILE.F90 /LINK WININET.LIB

INTERFACE  ! to 4 WinInet API functions contained in WININET.DLL

INTEGER FUNCTION InternetOpen [STDCALL,ALIAS:"_InternetOpenA@20"] &
                             (sAgent, nAccessType, sProxy, sBypass, nFlags)
 INTEGER :: nAccessType, nFlags
 CHARACTER(*) :: sAgent[REFERENCE], sProxy[REFERENCE], sBypass[REFERENCE]
END FUNCTION

INTEGER FUNCTION InternetOpenUrl [STDCALL,ALIAS:"_InternetOpenUrlA@"] &
                                (hInternet,sUrl,sHeaders,nHeadersLength,nFlags,nContext)
 INTEGER :: hInternet, nHeadersLength, nFlags, nContext
 CHARACTER(*) :: sUrl[REFERENCE], sHeaders[REFERENCE]
END FUNCTION

INTEGER FUNCTION InternetReadFile [STDCALL,ALIAS:"_InternetReadFile@16"] &
                                 (hFile, sBuffer, nBytesToRead, nBytesRead)
 INTEGER :: hFile, nBytesToRead, nBytesRead[REFERENCE]
 CHARACTER(*) :: sBuffer[REFERENCE]
END FUNCTION

INTEGER FUNCTION InternetCloseHandle [STDCALL,ALIAS:"_InternetCloseHandle@4"] (hInet)
 INTEGER :: hInet
END FUNCTION

INTEGER FUNCTION Nargs()   ! returns #args from command line
END FUNCTION
END INTERFACE

INTEGER,PARAMETER ::         &
NLEN            = 10000,     &  ! InternetReadFile #bytes requested/call
RELOAD          = #80000000, &  ! retrieve the original item
PASSIVE         = #08000000, &  ! used for FTP connections
NO_CACHE_WRITE  = #04000000, &  ! don't write this item to the cache
KEEP_CONNECTION = #00400000, &  ! use keep-alive semantics
IGNORE_TO_HTTP  = #00008000, &  ! ignore REDIRECT ex: https:// to http://
IGNORE_TO_HTTPS = #00004000, &  ! ignore REDIRECT ex: http://  to https://
RESYNCHRONIZE   = #00000800, &  ! asking wininet to update an item if it is newer
TRANSFER_BINARY = #00000002, &  !
FLAGS = NO_CACHE_WRITE  + KEEP_CONNECTION + RESYNCHRONIZE + RELOAD + PASSIVE + &
        TRANSFER_BINARY + IGNORE_TO_HTTPS + IGNORE_TO_HTTP

CHARACTER(14),PARAMETER :: sAgent = 'my wininet app'
CHARACTER,POINTER :: vfNullString=>NULL()

! - - - Local Variables - - -
INTEGER :: i, n, hSession, hUrl, nBytesRead, nTotalBytes
LOGICAL :: ok, keyin, suppress
CHARACTER(NLEN) :: sBuffer, sUrl*80, filename*20
! - - - - - - - - - - - - - -
1  keyin = .FALSE. ; suppress = .FALSE.

IF (Nargs() > 1) THEN             ! get url link from command line
   CALL GetArg(1, sUrl)
   IF (Nargs() > 2) suppress = .TRUE.  ! dont output successful messages
ELSE                              ! get url link from keyin
   WRITE (*,91) 'ENTER URL or hit <ENTER> to EXIT at >'
   WRITE (*,'(A\)') '>'
   READ (*,91) sUrl
   IF (sUrl == ' ') STOP
   keyin = .TRUE.
END IF
IF (sUrl(1:4) /= 'http'.AND.sUrl(1:3) /= 'ftp') THEN
   WRITE (*,91) 'GETFILE: URL doesnt begin with http OR ftp '
   GO TO 100
END IF
n = LEN_TRIM(sUrl)
DO i = n,4,-1                        ! scan back to find filename start
   IF (sUrl(i:i) == '/') EXIT
END DO
i = i+1
IF (sUrl(i:i+3) == 'www.') i = i+4   ! dont include 'www.' in filename
filename = sUrl(i:)                  ! note: filename is len=20 string
IF (.NOT.suppress) WRITE (*,91) 'GETFILE: ' // TRIM(filename) // '  FROM  ' // sUrl(1:i-1)

hSession = InternetOpen (sAgent, 0, vfNullString, vfNullString, 0)
IF (hSession == 0) THEN
   WRITE (*,91) 'GETFILE: FAILURE to get session handle'
   GO TO 100
END IF

sUrl = TRIM(sUrl) // CHAR(0)
hUrl = InternetOpenUrl (hSession, sUrl, CHAR(0), 0, FLAGS, 0)
IF (hUrl == 0) THEN
   WRITE (*,91) 'GETFILE: OPENURL FAIL'
   ok = InternetCloseHandle (hSession)
   GO TO 100
END IF

OPEN (1,FILE=TRIM(filename),FORM='BINARY')
nTotalBytes = 0
DO
   nBytesRead = 0
   ok = InternetReadFile (hUrl, sBuffer, NLEN, nBytesRead)
   IF (nBytesRead == 0) EXIT
   WRITE (1) sBuffer(1:nBytesRead)
   nTotalBytes = nTotalBytes + nBytesRead
   WRITE (*,'(1X,I0,2A\)') nTotalBytes/1000,'kb',CHAR(13) ! show progress
END DO
ok = InternetCloseHandle (hSession)

IF (nTotalBytes < 500) THEN   ! server rejection text is < 500 bytes
   WRITE (*,91) 'GETFILE: FAILURE < 500 bytes FILE is DELETED'
   CLOSE (1,STATUS='DELETE')
ELSE
   IF (.NOT.suppress) WRITE (*,91) 'GETFILE: SUCCESS #bytes = ',nTotalBytes
   CLOSE (1)
END IF

100 IF (keyin) GO TO 1   ! continue, exit only via blank<enter> keyin
STOP
91 FORMAT (A,I0)
END PROGRAM