! hello1.f90 ! Public domain 2007-2008 James Van Buskirk ! Compiled with: ! gfortran hello1.f90 -lkernel32 -ohello1 module Win32 use ISO_C_BINDING implicit none private public GetStdHandle interface function GetStdHandle(nStdHandle) bind(C,name='GetStdHandle') use ISO_C_BINDING implicit none integer(C_INTPTR_T) GetStdHandle integer(C_LONG), VALUE :: nStdHandle end function GetStdHandle end interface ! Possible values for nStdHandle integer(C_LONG), parameter, public :: STD_INPUT_HANDLE = -10 integer(C_LONG), parameter, public :: STD_OUTPUT_HANDLE = -11 integer(C_LONG), parameter, public :: STD_ERROR_HANDLE = -12 public OVERLAPPED_T type, bind(C) :: OVERLAPPED_T type(C_PTR) Internal type(C_PTR) InternalHigh type(C_PTR) Pointer ! Union with DWORD Offset; DWORD OffsetHigh integer(C_INTPTR_T) hEvent end type OVERLAPPED_T public WriteFile interface function WriteFile(hFile,lpBuffer, & nNumberOfBytesToWrite,lpNumberOfBytesWritten, & lpOverlapped) bind(C,name='WriteFile') use ISO_C_BINDING import OVERLAPPED_T implicit none integer(C_LONG) WriteFile integer(C_INTPTR_T), VALUE :: hFile character(kind=C_CHAR) lpBuffer(*) integer(C_LONG), VALUE :: nNumberOfBytesToWrite integer(C_LONG) lpNumberOfBytesWritten type(OVERLAPPED_T) lpOverLapped end function WriteFile end interface end module Win32 program hello use Win32 use ISO_C_BINDING implicit none integer(C_LONG) nStdHandle integer(C_INTPTR_T) hConsoleOutput integer(C_LONG) status character(80) Buffer integer(C_LONG) nNumberOfBytesToWrite integer(C_LONG) NumberOfBytesWritten type(OVERLAPPED_T), pointer :: lpOverlapped nStdHandle = -11 hConsoleOutput = GetStdHandle(nStdHandle) Buffer = 'Hello, world!'//achar(13)//achar(10) nNumberOfBytesToWrite = len_trim(Buffer) nullify(lpOverlapped) status = WriteFile(hConsoleOutput,Buffer, & nNumberOfBytesToWrite,NumberOfBytesWritten, & lpOverlapped) end program hello