- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
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
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
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.)
Link Copied
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
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
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
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.)
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
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.

- Subscribe to RSS Feed
- Mark Topic as New
- Mark Topic as Read
- Float this Topic for Current User
- Bookmark
- Subscribe
- Printer Friendly Page