FormatMessage call no longer working

[SoniaG]

Hello,

The following subroutine calling FormatMessage was originally taken from an example provided by Steve Lionel in this forum and has worked for many years. Unfortunately, following an update the following compiler error occurs:

error #9022: The argument to C_LOC must be a variable with the POINTER or TARGET attribute. [MESSAGE_BUFFER_CPTR].

When I substitute the declaration of :

type(C_PTR) :: message_buffer_cptr

with

type(C_PTR), pointer :: message_buffer_cptr, the program compiles and runs but always returns a zero.

Can anyone see what needs changing? Thanks in advance!

subroutine WinErr(hDlg,origin)

use kernel32
use, intrinsic :: iso_c_binding
use ifwin

implicit none

character(*),intent(IN) :: origin

integer(DWORD) ::		hDlg
integer(DWORD) ::		last_error
integer(DWORD) ::		nTchars
integer(HANDLE) ::	        iret

type(C_PTR) ::                  message_buffer_cptr
character, pointer ::	      message_buffer(:)
character(1024) ::		MessageString

!**********************************************************************************************************************************************

! Get the actual system error code
last_error = GetLastError ()

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 (MessageString,'(A,Z8.8,3A,Z8.8)') "Format message failed for status ", last_error, " while error status = ", GetLastError()
else
   call C_F_POINTER (message_buffer_cptr, message_buffer, [nTchars])
  write (MessageString,'(*(A))')message_buffer
  iret = LocalFree (TRANSFER(message_buffer_cptr, 0_HANDLE))
end if

iret = MessageBox(hDlg,trim(MessageString)//char(13)//"Error originated in: '"// &
		origin//"'."//char(0),"Error"C,MB_OK)
return
end subroutine WinErr

[andrew_4619]

    integer(dword)     :: imes
    character(len=512), target :: gbuf
    imes = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, 0_LPCVOID, &
                                                  ierr,0_DWORD, &
                                transfer(c_loc(gbuf),0_handle), &
                                len(gbuf,dword), 0_handle )

This is some code that works, you are passing and integer value of the GBUF address and formatmessage is dumping a string starting at that location. Gbuf needs the target attribute for C_LOC

[mfinnis · Accepted solution]

The clue is in the error message. Give message_buffer_cptr the target attribute (rather than making it a pointer). (Note that should you build with x64 configuration you will need to pay attention to your integer declarations. In particular hDlg should be HANDLE not DWORD.)

[SoniaG]

Thank you very much for the responses.  It was staring me in the face of course!

I just switched the line:

type(C_PTR) :: message_buffer_cptr to:

type(C_PTR), target :: message_buffer_cptr

and all is well.

Many thanks.