Get Error String from windows using FormatMessage API function

[dannycat]

I'm trying to use the FormatMessage function to obtain the error message when windows functions fail. The functions I'm particularly interested in are CopyFile and CreateProcess. The follow subroutine is my first attempt to get the error message but so far I've had no joy.

subroutine w32_CheckError

!**********************************************************
! Check for Windows W32 Error And Display Message
!**********************************************************

use dfwin, NULLPTR => NULL
use kernel32

implicit none

! Local Variables
character*255 :: string
integer :: nchar

nchar = FormatMessage(ior(FORMAT_MESSAGE_ALLOCATE_BUFFER,ior(FORMAT_MESSAGE_FROM_SYSTEM, &
                                           FORMAT_MESSAGE_IGNORE_INSERTS)), &
                                          NULL, &
                                          GetLastError(), &
                                          int(MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),DWORD), & ! Default language
                                          ! LANG_NEUTRAL, & ! Default language
                                          string, &
                                          255, &
                                         NULL)

! Display the string.
if(nchar.gt.0) then
   call grp_message('Windows Error: '//trim(string(1:nchar)))
endif

return
end subroutine

When I try this the contents of string is garbled. Has anyone successfully used this in a FORTRAN context that can tell me what I'm doing wrong.

Thanks in advance.

Steve

[Les_Neilson]

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

[Steven_L_Intel1]

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.

[JVanB]

[fortran] !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. [/fortran]

[dannycat]

Thanks for the information, but do we need to go to so much trouble when a function is already available?

[JVanB]

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.

[Paul_Curtis]

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. [fortran] 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 [/fortran]

[dannycat]

Thanks Paul, Your routine is similar to what I had originally. I had FORMAT_MESSAGE_ALLOCATE_BUFFER in dwFlags which may be what caused a problem otherwise they are essentially the same. Is the banner variable is defined in a module (as a character(255) :: banner(2) or similar) that contains this function. What does no_errorlog variable do (there is no check on optional variable - should it be API_error_report and why is function defined as recursive? I assume this has been cut out of a larger chunk of code. Steve

[Paul_Curtis]

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, [fortran] 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 [/fortran]

[JVanB]

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: [fortran]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 [/fortran]

[Steven_L_Intel1]

FWIW, here's a routine I put into the DynamicLoad sample that uses FormatMessage: [fortran] ! 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 [/fortran]

[JVanB]

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.

[Steven_L_Intel1]

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.

[Steven_L_Intel1]

Ok, here's a revised version that uses only standard Fortran features (and the Windows API). [fortran] 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 [/fortran]

[JVanB]

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.

[Steven_L_Intel1]

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.

[JVanB]

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 [fortran] character(:), pointer :: message_buffer [/fortran] and then we could replace the line [fortran] call C_F_POINTER (message_buffer_cptr, message_buffer, [nTchars]) [/fortran] with [fortran] BLOCK character(nTchars), pointer :: temp call C_F_POINTER(message_buffer_cptr,temp) message_buffer => temp END BLOCK [/fortran] 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.

[Steven_L_Intel1]

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

[dannycat]

Thanks to both of you guys for the info, it has been very helpful. I didn't expect such in depth discussion over what seemed like a fairly straightforward question. I do think there is scope for someone to write a book which covers all aspects of using Window API from a FORTRAN environment. When I initially started using the API back in 2000 I had to use a lot of trial and error approaches, using information from MSDN and Windows programming books (in C) to get certain functions to work however I always found the area not covered very well, from a FORTRAN programmers viewpoint, was dealing with functions that had pointer arguments or returns. I have since found the best way is to look in the ifwin/ifwinty... module sources to identify the actual arguments to use although in this particular case whatever I tried didn't produce a meaningful text string even though the function returned a non zero value. In the module source there is more than one interface defined for FormatMessage which enables both character string and pointers to be used. We now have an example of both. In your latest example, Steve, is it safe to assume that if the FormatMessage function fails the associated memory for the message buffer pointer has not been allocated? In other words should the LocalFree function be called outside the if/endif structure and after checking status of the pointer?

[Steven_L_Intel1]

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.

[dannycat]

Thanks Steve, I did get this book when it came out and would have been exceptionally useful if I'd had it a few years before it was published. As it was I did find it useful for explaining how to do lots of things I hadn't done before. I would recommend it to anyone attempting windows programming but it would benefit from an update to include the Intel variable definitions (HANDLE, DWORD, FPARAM, etc) and the changes required for 64-bit code etc.