■

Linker Option

PROGRAM www
USE ifwina
IMPLICIT NONE
INTEGER, PARAMETER :: INTERNET_OPEN_TYPE_PRECONFIG = 0 !  // use registry configuration
INTEGER, PARAMETER :: INTERNET_OPEN_TYPE_DIRECT    = 1 !  // direct to net
INTEGER, PARAMETER :: INTERNET_OPEN_TYPE_PROXY     = 3 !  // via named proxy
INTEGER, PARAMETER :: INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY = 4 ! // prevent using java/script/INS
!
INTERFACE
 INTEGER (HANDLE) FUNCTION InternetOpen(arg1, arg2, arg3, arg4, arg5)
 USE ifwinty
 !DEC$ ATTRIBUTES DEFAULT, STDCALL, DECORATE, ALIAS:'InternetOpenA' :: InternetOpen
 INTEGER (LPLONG) :: arg1
 INTEGER (DWORD)  :: arg2
 INTEGER (LPLONG) :: arg3
 INTEGER (LPLONG) :: arg4
 INTEGER (DWORD)  :: arg5
 END FUNCTION
!
 INTEGER (HANDLE) FUNCTION InternetOpenUrl(arg1, arg2, arg3, arg4, arg5, arg6)
 USE ifwinty
 !DEC$ ATTRIBUTES DEFAULT, STDCALL, DECORATE, ALIAS:'InternetOpenUrlA' :: InternetOpenUrl
 INTEGER (HANDLE) :: arg1
 INTEGER (LPLONG) :: arg2
 INTEGER (LPLONG) :: arg3
 INTEGER (DWORD)  :: arg4
 INTEGER (DWORD)  :: arg5
 INTEGER (DWORD)  :: arg6
 END FUNCTION
!
INTEGER (BOOL) FUNCTION InternetReadFile(arg1, arg2, arg3, arg4)
 USE ifwinty
 !DEC$ ATTRIBUTES DEFAULT, STDCALL, DECORATE, ALIAS:'InternetReadFile' :: InternetReadFile
 INTEGER (HANDLE)  :: arg1
 INTEGER (LPVOID)  :: arg2
 INTEGER (DWORD)   :: arg3
 INTEGER (LPDWORD) :: arg4
 END FUNCTION
!
INTEGER (BOOL) FUNCTION InternetCloseHandle(arg1)
 USE ifwinty
 !DEC$ ATTRIBUTES DEFAULT, STDCALL, DECORATE, ALIAS:'InternetCloseHandle' :: InternetCloseHandle
 INTEGER (HANDLE) :: arg1 
 END FUNCTION
END INTERFACE
!
!
!
INTEGER (HANDLE) :: hInt, hUrl
INTEGER (BOOL) :: iret
INTEGER (DWORD) :: dwret, dwtot
CHARACTER (LEN =  80) :: agent = 'Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)'//CHAR(0)
CHARACTER (LEN = 256) :: strurl, buff
CHARACTER (LEN = 256), ALLOCATABLE :: srctext(:)
INTEGER :: i
hInt = InternetOpen(LOC(agent), INTERNET_OPEN_TYPE_PRECONFIG, NULL, NULL, 0)
IF (hInt == 0) PRINT *, 'Open error' 
strurl = 'http://www.hatena.ne.jp/'C
hUrl = InternetOpenUrl(hInt, LOC(strurl), NULL, -1, 0, 0)
dwtot = 0
ALLOCATE(srctext(1000))
OPEN(9, FORM ='binary')
DO i = 1, 1000
 iret = InternetReadFile(hUrl, LOC(buff), LEN(buff), LOC(dwret))
 IF (dwret == 0) EXIT
 dwtot = dwtot + dwret
 WRITE(9) buff(1:dwret)
 srctext(i) = buff(1:dwret)
 IF (i == 1000) STOP 'buffer overflow '
END DO
print *, srctext(1:i - 1), srctext(i)(1:dwret)
print *, dwtot, 'bytes'
iret = InternetCloseHandle(hUrl)
iret = InternetCloseHandle(hInt)
STOP
END PROGRAM www