I'm not sure but do you need to call getlasterror first then pass that error code into formatmessage?
Les

He's got a call to GetLastError in the argument list. I will have to compare this to a working example I have to see if I can see what might be wrong.

!DEC$ IF(.FALSE.)

module ifwin

   use ISO_C_BINDING

   implicit none

   private

   integer, parameter, public :: DWORD = C_LONG

   integer, parameter, public :: HANDLE = C_INTPTR_T

   integer, parameter, public :: USHORT = C_SHORT

   integer, parameter, public :: BOOL = C_INT

   integer(DWORD), parameter, public :: &

      FORMAT_MESSAGE_ALLOCATE_BUFFER = int(Z'00000100',DWORD)

   integer(DWORD), parameter, public :: &

      FORMAT_MESSAGE_ARGUMENT_ARRAY = int(Z'00002000',DWORD)

   integer(DWORD), parameter, public :: &

      FORMAT_MESSAGE_FROM_HMODULE = int(Z'00000800',DWORD)

   integer(DWORD), parameter, public :: &

      FORMAT_MESSAGE_FROM_STRING = int(Z'00000400',DWORD)

   integer(DWORD), parameter, public :: &

      FORMAT_MESSAGE_FROM_SYSTEM = int(Z'00001000',DWORD)

   integer(DWORD), parameter, public :: &

      FORMAT_MESSAGE_IGNORE_INSERTS = int(Z'00000200',DWORD)

   integer(DWORD), parameter, public :: &

      FORMAT_MESSAGE_MAX_WIDTH_MASK = int(Z'000000FF',DWORD)

   integer(USHORT), parameter, public :: &

      LANG_NEUTRAL = int(Z'0000',USHORT)

   integer(USHORT), parameter, public :: &

      SUBLANG_DEFAULT = int(Z'0001',USHORT)

   integer(USHORT), parameter, public :: &

      SUBLANG_NEUTRAL = int(Z'0000',USHORT)

   integer(BOOL), parameter, public :: TRUE = int(1, BOOL)

   integer(BOOL), parameter, public :: FALSE = int(0, BOOL)

   public FormatMessage

   interface

      function FormatMessage(dwFlags, lpSource, dwMessageId, &

         dwLanguageId, lpBuffer, nSize, Arguments) &

         bind(C, name = 'FormatMessageA')

         import

         implicit none

!GCC$ ATTRIBUTES STDCALL :: FormatMessage

         integer(DWORD) FormatMessage

         integer(DWORD), value :: dwFlags

         integer(HANDLE), value :: lpSource

         integer(DWORD), value :: dwMessageId

         integer(DWORD), value :: dwLanguageId

         type(C_PTR), value :: lpBuffer

         integer(DWORD), value :: nSize

         type(C_PTR), value :: Arguments

      end function FormatMessage

   end interface

   public GetLastError

   interface

      function GetLastError() bind(C, name = 'GetLastError')

         import

         implicit none

!GCC$ ATTRIBUTES STDCALL :: GetLastError

         integer(DWORD) GetLastError

      end function GetLastError

   end interface

   public CopyFile

   interface

      function CopyFile(lpExistingFileName, lpNewFileName, &

         bFailIfExists) bind(C, name = 'CopyFileA')

         import

         implicit none

!GCC$ ATTRIBUTES STDCALL :: CopyFile

         integer(BOOL) CopyFile

         character(kind=C_CHAR) lpExistingFileName(*)

         character(kind=C_CHAR) lpNewFileName(*)

         integer(BOOL), value :: bFailIfExists

      end function CopyFile

   end interface

   public MAKELANGID

   contains

      function MAKELANGID(PrimaryLanguageID, SubLanguageId) &

         bind(C, name='MAKELANGID')

         integer(DWORD) MAKELANGID

         integer(USHORT), value :: PrimaryLanguageID

         integer(USHORT), value :: SubLanguageID
         MAKELANGID = IOR(int(PrimaryLanguageID,DWORD), &

            ISHFT(int(SubLanguageID,DWORD),10))

      end function MAKELANGID

end module ifwin

!DEC$ ENDIF
module string_utils

   use ISO_C_BINDING

   implicit none

   private

   public ftn_strlen

   interface

      function ftn_strlen(str) bind(C, name = 'ftn_strlen')

         import

         implicit none

         integer(C_SIZE_T) ftn_strlen

         type(C_PTR), value :: str

      end function ftn_strlen

   end interface

   public point_deferred

   contains

      function strlen_char(str) bind(C, name = 'ftn_strlen')

         integer(C_SIZE_T) strlen_char

         character(kind=C_CHAR) str(*)
         do strlen_char = 0, huge(strlen_char)-2

            if(str(strlen_char+1) == achar(0)) return

         end do

      end function strlen_char

      subroutine point_deferred(str, fptr, length)

         type(C_PTR), value :: str

         character(:,C_CHAR), pointer :: fptr

         integer(C_SIZE_T), value :: length

         character(length,C_CHAR), pointer :: temp
         call C_F_POINTER(str, temp)

         fptr => temp

      end subroutine point_deferred

end module string_utils
program start

   use ifwin

   use ISO_C_BINDING

   use string_utils

   implicit none

   integer(DWORD) status

   type(C_PTR), target :: lpBuffer

   character(32,C_CHAR) lpExistingFileName

   character(32,C_CHAR) lpNewFileName

   integer(BOOL) bstatus

   integer(DWORD) estatus

   integer(C_SIZE_T) length

   character(:,C_CHAR), pointer :: mess

   integer(HANDLE) lpSource
   lpExistingFileName = 'NoIDontExist.dat'//achar(0)

   lpNewFileName = 'MeNeither.dat'//achar(0)

   bstatus = CopyFile( &

      lpExistingFileName = lpExistingFileName, &

      lpNewFileName = lpNewFileName, &

      bFailIfExists = TRUE)

   estatus = GetLastError()

!   lpSource = transfer(C_NULL_PTR, lpSource) ! Causes ICE

   lpSource = transfer(lpBuffer, lpSource)

   status = FormatMessage( &

      dwFlags = iany([FORMAT_MESSAGE_ALLOCATE_BUFFER, &

         FORMAT_MESSAGE_FROM_SYSTEM,FORMAT_MESSAGE_IGNORE_INSERTS]), &

      lpSource = lpSource, &

      dwMessageId = estatus, &

!      dwLanguageId = MAKELANGID(LANG_NEUTRAL,SUBLANG_NEUTRAL), &

      dwLanguageId = MAKELANGID(LANG_NEUTRAL,SUBLANG_DEFAULT), &

      lpBuffer = C_LOC(lpBuffer), &

      nSize = 255_DWORD, &

      Arguments = C_NULL_PTR)

   write(*,'(a,i0)') 'Return value from CopyFile = ', bstatus

   write(*,'(a,i0)') 'Return value from GetLastError = ', estatus

   length = ftn_strlen(lpBuffer)

   call point_deferred(lpBuffer, mess, length)

   write(*,'(a)') mess

end program start
! Program output (gfortran):

!Return value from CopyFile = 0

!Return value from GetLastError = 2

!The system cannot find the file specified.

Ifort already provides the Windows interfaces, types, and constants, so it doesn't need the stuff between !DEC$ IF(.FALSE.) and !DEC$ ENDIF (lines 1:164) in my example above. I only had that in there because I compiled with gfortran, not having a recent version of ifort. You do need the rest of it, but for some reason the syntax highlighter double-spaces everything you paste into it, so the example would only be about (306-165+1)/2 = 76 lines long, and that's using the verbose format with keywords for actual arguments, which I find more readable for Win32 functions.
Ifort may require some different data types for the Win32 functions because it's written to cray pointers rather than f2003 C interoperability, but the conversion should be should be easy and is left as an exercise to the reader.
Also I meant to set lpBuffer = C_NULL_PTR on line 266, but the value of lpSource is ignored for this value of dwFlags anyway.

Windows error reporting can be accomplished a lot more simply; in the following, the error messages are written to text array banner(), which is displayed in its own window.

RECURSIVE SUBROUTINE API_Error (locus, no_errorlog)

	USE kernel32

    IMPLICIT NONE

    INTEGER, INTENT(IN)			    :: locus

	INTEGER, INTENT(IN), OPTIONAL	:: no_errorlog

    INTEGER							:: lastError

    INTEGER							:: rval
	lastError = GetLastError()

	IF (lastError == ERROR_SUCCESS) RETURN
	rval = FormatMessage_G1	(	IOR(FORMAT_MESSAGE_FROM_SYSTEM,		&

									FORMAT_MESSAGE_IGNORE_INSERTS),	&

								NULL,								&

								lastError,							&

								0,									&

								banner(2),	    					&

								LEN(banner(2)),	    				&

								NULL								)

	banner(2) = ADJUSTL(banner(2))
    IF (API_error_report) CALL show_banner (locus)
END SUBROUTINE API_Error

Yes, this sample was edited a bit. The no_errorlog flag allows error checking to be skipped at certain points in the calling program. The function is recursive since it is called from API wrapper functions in multiple threads. banner() is an array of 255-char strings; the initial member banner(1) is usually preset with content identifying the calling locus, and as shown banner(2) will be filled with the API error message. For example,

rval = CreateDialogParam (GetResDLLInst(), resId, hwndP, &

						  dialogProc, resId)

IF(rval /= 0) THEN

    DialogCreate = rval

ELSE

	banner(1) = 'CreateDialogParam'

    CALL API_Error (812)

    DialogCreate = -1

END IF

Cita:

dannycat wrote:

I had FORMAT_MESSAGE_ALLOCATE_BUFFER in dwFlags which may be what caused a problem otherwise they are essentially the same.

FORMAT_MESSAGE_ALLOCATE_BUFFER is the f90 way to do things with dynamic memory. It doesn't in itself cause a problem, but you have to do 3 things to implement the dynamic memory approach.

1. You have to allocate the memory and get its handle.
   FORMAT_MESSAGE_ALLOCATE_BUFFER tells FormatMessage to allocate memory for the output string. To capture the handle, you want to change the way you invoke FormatMessage a little. First put
   
   use ISO_C_BINDING
   
   among your USE statements. Then declare
   
   integer, parameter :: nbits = bit_size(0_HANDLE)/bit_size(0_byte)
   
   this gives you the size of a pointer in bytes in case you want the same code to work in both 32- and 64-bit mode. Now you can declare
   
   character(nbits,C_CHAR) capture
   
   which gives you the right size of variable to capture the C_PTR that FormatMessage will return as the pointer to the error string in the memory it allocated for you. Now you can change the lpBuffer argument of FormatMessage from string to capture and the nsize argument to 1 because at minimum we need the space for the terminating ASCII NUL.
2. You need to convert the C_PTR that FormatMessage returned to something Fortran can digest. For this, we need to USE the module that has the conversion subroutine
   
   use string_utils
   
   and change the declaration of string to
   
   character(:,C_CHAR), pointer :: string
   
   Now we can carry out the conversion given the right kind of subroutine:
   
   call CharStar2Deferred(transfer(capture,C_NULL_PTR),string)
   
   string now has your error message and is already just the right length.
3. Since the dynamic memory wasn't allocated as a Fortran ALLOCABABLE, we are going to need to deallocate it somehow after use. At the end of the subroutine you need
   
   nchar = LocalFree(transfer(capture,0_HANDLE))
   
   to do this.

The f90 way seems a little more complicated, but it avoids the f77 dilemma of having to create variables "big enough" to hold the results you get, which can lead to buffer overruns if the variables are too small and is wasteful of resources and time if they are too large.
Oh yes, you need the definition of string_utils:

module string_utils

   use ISO_C_BINDING

   implicit none

   private

   public CharStar2Deferred

   interface

      function ftn_strlen(str) bind(C, name = 'ftn_strlen')

         import

         implicit none

         integer(C_SIZE_T) ftn_strlen

         type(C_PTR), value :: str

      end function ftn_strlen

   end interface

   contains

      subroutine CharStar2Deferred(CharStar, Deferred)

         type(C_PTR), value :: CharStar

         character(:,C_CHAR), pointer, intent(out) :: Deferred

         integer(C_SIZE_T) strlen
         strlen = ftn_strlen(CharStar)

         call point_deferred(CharStar, Deferred, strlen)

      end subroutine CharStar2Deferred

      function strlen_char(str) bind(C, name = 'ftn_strlen')

         integer(C_SIZE_T) strlen_char

         character(kind=C_CHAR) str(*)
         do strlen_char = 0, huge(strlen_char)-2

            if(str(strlen_char+1) == achar(0)) return

         end do

      end function strlen_char

      subroutine point_deferred(str, fptr, length)

         type(C_PTR), value :: str

         character(:,C_CHAR), pointer :: fptr

         integer(C_SIZE_T), value :: length

         character(length,C_CHAR), pointer :: temp
         call C_F_POINTER(str, temp)

         fptr => temp

      end subroutine point_deferred

end module string_utils

FWIW, here's a routine I put into the DynamicLoad sample that uses FormatMessage:

! Error processing routine.  Gets the system error and

! its corresponding string, prints a message, then stops

! execution

!

subroutine print_error (string)

use kernel32

implicit none
character(*), intent(IN) :: string
integer(DWORD) last_error

integer(DWORD) nTchars

character(200) message_buffer
! Get the actual system error code

!

last_error = GetLastError ()
! Get the string corresponding to this error

!

nTchars = FormatMessage (FORMAT_MESSAGE_FROM_SYSTEM, & ! dwflags

  NULL, & ! lpsource - ignored

  last_error, & ! dwMessageId

  0, & ! dwLanguageId

  message_buffer, & ! lpBuffer

  len(message_buffer), & !nSize

  NULL) ! Arguments
if (nTchars == 0) then

  write (*,'(A,Z8.8,3A,Z8.8)') "Format message failed for status ", last_error, " while ", &

    string, ": error status = ", GetLastError()

else

  write (*,'(4A)') "Error while ", string, ": ", message_buffer(1:nTchars)

  end if
stop
end subroutine print_error

MSDN warns about using FORMAT_MESSAGE_FROM_SYSTEM without FORMAT_MESSAGE_IGNORE_INSERTS. Also a search found 84 system error codes longer than 200 characters up to code 10401 at 2174 characters, although I suppose this depends on the version of Windows.

Thanks for the observations, RO - good points. I also see that one can ask FormatMessage to allocate the message bufffer - think I'll play with that.

Ok, here's a revised version that uses only standard Fortran features (and the Windows API).

subroutine print_error (string)

use kernel32

use, intrinsic :: iso_c_binding

implicit none
character(*), intent(IN) :: string
integer(DWORD) :: last_error

integer(DWORD) :: nTchars

integer(HANDLE) :: ret

type(C_PTR) :: message_buffer_cptr

character, pointer :: message_buffer(:)
! Get the actual system error code

!

last_error = GetLastError ()
! Get the string corresponding to this error

! Use the option to have Windows allocate the message buffer - it puts the

! addess in the lpBuffer argument. Here we pass it the C_PTR message_buffer_cptr,

! using TRANSFER to cast the address to an LPVOID.  FORMAT_MESSAGE_IGNORE_INSERTS

! is used so that it doesn't try looking for arguments - a possible security violation.

! Again, we're using C interoperability features.

!

nTchars = FormatMessage (IOR(IOR(FORMAT_MESSAGE_FROM_SYSTEM, FORMAT_MESSAGE_IGNORE_INSERTS), &

                             FORMAT_MESSAGE_ALLOCATE_BUFFER), & ! dwflags

  NULL, & ! lpsource - ignored

  last_error, & ! dwMessageId

  0, & ! dwLanguageId

  TRANSFER(C_LOC(message_buffer_cptr), 0_LPVOID), & ! lpBuffer

  100, & !nSize - minimum size to allocate

  NULL) ! Arguments
if (nTchars == 0) then

  write (*,'(A,Z8.8,3A,Z8.8)') "Format message failed for status ", last_error, " while ", &

    string, ": error status = ", GetLastError()

else

  ! message_buffer_cptr is now pointing to the message. Use C_F_POINTER to convert

  ! this to an array of characters.

  call C_F_POINTER (message_buffer_cptr, message_buffer, [nTchars])

  write (*,'(3A,*(A))') "Error while ", string, ": ", message_buffer

  ret = LocalFree (TRANSFER(message_buffer_cptr, 0_HANDLE))

  end if
stop
end subroutine print_error

My previous observations were made so that you might read my previous posts to this thread and improve your code accordingly. Let me just point out that you missed a few features that my code had:

1. I think the syntax with IANY([]) is easier to read than multiple IOR()s and I'm not the only one who thinks that.
2. Why do you put keywords in comments rather than simply using keyword syntax which is at least as clear and combines compiler checking with your comments?
3. I also think it's more natural from the Fortran programmers point of view to cast the message to a deferred-length scalar rather than an array of CHARACTER*1 elements. For example "Error while "//string//": "//message_buffer would be OK for the scalar but not the array.

1 and 2 are good points. Habits...

3 - Your code, which I had not studied in detail before, uses additional procedures to set the character length. I didn't want to get that complicated in my sample (where this was not the primary thing being illustrated.) I agree that if one wanted to use the message in a string context that your approach would be useful.

The front end procedure was there only to find the length of the NUL-terminated string and the back end procedure created a scope where we could have a pointer to a scalar character variable that we could point at the C string with C_F_POINTER. Since FormatMessage already returns the length we could dispense with all procedure calls in your sample by changing the declaration of message_buffer to

   character(:), pointer :: message_buffer

and then we could replace the line

   call C_F_POINTER (message_buffer_cptr, message_buffer, [nTchars])

with

   BLOCK

      character(nTchars), pointer :: temp

      call C_F_POINTER(message_buffer_cptr,temp)

      message_buffer => temp

   END BLOCK

But I considered the original question to be more like "Help, I've been given a C_PTR the points at a NUL-terminated C string (like C always gives you) and don't know what to do with it." Rather than "I don't know how to make FormatMessage work," so I posted code that converts the C_PTR to a Fortran pointer that points at a deferred-length string. As can be seen, in this case the solution can be more self-contained.

Sadly, Intel Fortran doesn't yet support BLOCK. Otherwise, that would be a fine solution.

If the return value from FormatMessage is 0 you can assume it failed and did not allocate anything.

There IS a book on calling Windows API code from Fortran, though it is more than a decade old. It still is largely relevant. "Compaq Visual Fortran: A Guide to Developing Windows Applications" by Norman Lawrence. It does not cover all of the APIs, but does have a lot of useful detail.