call “JVM_UNSAFE_NATIVE_MEMCOPY” using by value nativePointer by value memoryLength by value managedPointer returning status-code end-call
$IF JVM32 DEFINED 01 native-pointer is typedef pic x(4) comp-5. $ELSE 01 native-pointer is typedef pic x(8) comp-5. $END
0 | success |
1 | a bad length has been given |
$set ans85 mf defaultbyte"00" case $ if jvmgen set $ set remove"internal" remove"event" $end copy "windows.cpy". program-id. geterror. special-names. call-convention 74 is winapi. data division. working-storage section. $if jvmgen set $ if NOP64 set 01 native-pointer is typedef pic x(4) comp-5. $ else 01 native-pointer is typedef pic x(8) comp-5. $ end $else 01 native-pointer is typedef pointer. $end 01 format-message-group. 03 last-error DWORD. 03 message-pointer native-pointer. 03 format-type DWORD. 03 bytes-returned DWORD. 03 last-error-display pic 9(2). local-storage section. 01 ls-message-buffer pic x(1024). linkage section. 01 lnk-message-buffer pic x(1024). procedure division. $if jvmgen set call "cob32api" $end display "First 20 system error messages" perform display-error varying last-error from 0 by 1 until last-error = 20 stop run. display-error. move 0 to format-type add FORMAT-MESSAGE-ALLOCATE-BUFFER to format-type add FORMAT-MESSAGE-FROM-SYSTEM to format-type call winapi FormatMessage using by value format-type by value 0 size 4 *> lpSource ignored by value last-error *> error number by value 0 size 4 *> LangID ignored by reference message-pointer*> pointer to mess. by value 0 size 4 *> min size of buffer by value 0 size 4 *> arguments ignored returning bytes-returned end-call if bytes-returned > 0 and bytes-returned < length of ls-message-buffer $if jvmgen set *> use the managed memory instead of the native memory set address of lnk-message-buffer to address of ls-message-buffer *> Copy the native memory to to the managed memory call "JVM_UNSAFE_NATIVE_MEMCOPY" using by value message-pointer by value bytes-returned by value address of ls-message-buffer end-call $else set address of lnk-message-buffer to message-pointer $end move last-error to last-error-display display " " last-error-display " = " lnk-message-buffer (1:bytes-returned - 2) *> remove x"ODOA" call winapi "LocalFree" using by value message-pointer end-call end-if.