First of all: Sorry for posting the code inside the Text. But It’s not possible for me to attach a File with the extension NSN…
At our company, the ADABAS databases and the NATURAL Runtime Environment is hosted on the same computer. So it’s possible to find out the real name of the user who holds a record by using the programs I attached to this post.
But I’m sure there’s still a lot to improve. For example:
- Is it possible to do the whole thing without using so many workfiles and “CALL ‘SHCMD’”?
- What about remote databases? We can get no information about them, because they’re connected to our Natural via EntireX…
Kind regards,
Matthias
*
* Find out real name of user, who holds a record
*************************************************
*
* Usage:
*
** In the program, which does the login:
** --> write information into a Userlogfile
*
* COMPRESS 'echo PID' *PID 'User' *USER '>>/tmp/user.log' into #cmd
* CALL 'SHCMD' #cmd
*
** In every dialog-program
*
* ON ERROR
* IF *ERROR-NR = 3145
* CALLNAT 'ADAHLD-N' #ISN #RETURNCODE #USER_ID
* DECIDE ON FIRST VALUE OF #RETURNCODE
* VALUE 0
* input 'Record is held by' #USER_ID (AD=O) /
* 'Press ENTER to RETRY'
* RETRY
* VALUE 1 : 5
* input 'Record is held by some other user' /
* 'Press ENTER to RETRY'
* RETRY
* NONE VALUE
* write 'Internal error calling ADAHLD-N' #RETURNCODE
* END-DECIDE
* END-IF
* END-ERROR
*
* Input-Parameter:
* 1. ISN /* UDB and FileNo are detected automatically
*
* Output-Parameter
* 2. RETURNCODE
* 0 = sucessfully terminated
* 1 = Error during detecting File-No. (USR2010N)
* 2 = Error during calling USR1040N
* 3 = Error during calling OS-command 'adaopr ... di=hq'
* 4 = Error during detecting PID
* 5 = real USER name not knwon
* (maybe record is locked by a batch user)
* > 5 = NATURAL-Runtime error (*ERROR-NR)
*
* 3. USER_ID
*
***********************************************************************
*
define data parameter
*
01 #input-parameter
02 ISN (P10) BY VALUE
01 #output-parameter
02 RETURNCODE (I04) BY VALUE RESULT
02 USER_ID (A08) BY VALUE RESULT
*
local
*
01 #options
02 workfile-folder (A) DYNAMIC const <'/tmp/'> /* with slash at end!
02 user-logfile (A) DYNAMIC const <'/tmp/user.log'>
*
01 #usr2010 (A16)
01 redefine #usr2010
02 DB_STATUS (A1) /* Status code
02 DB_TYPE (A1) /* DB type
02 DB_DBID (B2) /* Databas ID
02 DB_FNR (B2) /* File number
02 DB_COMMAND (A2) /* Database Command
02 DB_RESP (B2) /* Response Code
02 DB_SUBCODE (B2) /* Response subcode
02 DB_ADD1F2B (B2) /* first 2 bytes off additions1 field
*
01 #FILE_A (A) DYNAMIC
01 #ISN_A (A) DYNAMIC
01 #FILE_I (I4)
01 #DBID_I (I4)
01 #ESID_I (I4)
01 #line-tab (A/1:7) DYNAMIC
*
01 #WORKFILE (A) DYNAMIC
01 #LINE (A80) /* WORKFILE-Line. Listing: "adaopr di=hq"
01 redefine #line
02 FILLER 37X
02 ESID (A05)
02 FILLER 03X
02 ETID (A08)
*
01 #USR1040
02 DBID (N05)
02 RESPONSE (I04)
*
01 #command (A) DYNAMIC
*
end-define
*
ON ERROR
MOVE *ERROR-NR to #output-parameter.RETURNCODE
escape module
END-ERROR
*
*
reset #output-parameter
*
* get last DB call error
*
callnat 'USR2010N' #USR2010
*
#DBID_I := #usr2010.DB_DBID
#FILE_I := #usr2010.DB_FNR
*
IF #FILE_I = 0
#output-parameter.RETURNCODE := 1
escape module
END-IF
*
IF #DBID_I = 0
callnat 'USR1040N' 'G' #USR1040
if #usr1040.response ne 0
#output-parameter.RETURNCODE := 2
escape module
end-if
#DBID_I := #usr1040.DBID
END-IF
*
* call OS-command ADAOPR and redirect output into a workfile
*
MOVE EDITED #input-parameter.ISN (EM=-Z,ZZZ,ZZZ,ZZ9) to #ISN_A
*
MOVE EDITED #FILE_I (EM=ZZZZ9) to #FILE_A
*
* create an unique name for temporary workfile
compress #options.workfile-folder
*PROGRAM '_' #DBID_I '_' *PID '.txt'
into #workfile leaving no
*
* no adaopr-parameter FILE/ISN, because ISN has a maximum of 65535 then
*
compress 'adaopr db=' #DBID_I " di=hq | tail +12 | grep '^.\{54\}"
#FILE_A #ISN_A "$' >" #workfile " 2>/dev/null"
into #command leaving no
*
call 'shcmd' #command
if ret('shcmd') ne 0
#output-parameter.RETURNCODE := 3
perform delete-workfile
escape module
end-if
*
* read WORKFILE and delete it
*
define work file 1 #workfile
read work 1 once #line
close work file 1
perform delete-workfile
*
#ESID_I := val(#line.ESID)
*
* read userlog-file
*
if #line.ESID = ' '
#output-parameter.RETURNCODE := 4
escape module
end-if
*
define work file 2 #options.user-logfile
read work 2 #line
separate #line into #line-tab(*) with delimiters H'20'
reject if #line-tab(1) ne 'PID'
reject if #line-tab(3) ne 'User'
reject if val(#line-tab(2)) ne #ESID_I
#output-parameter.USER_ID := #line-tab(4)
end-work
close work file 2
*
if #output-parameter.USER_ID = ' '
#output-parameter.RETURNCODE := 5
escape module
end-if
*
*
define subroutine delete-workfile
*
if *LENGTH(#workfile) > 0
compress 'rm -f ''' #workfile '''' into #command leaving no
call 'shcmd' #command
end-if
*
end-subroutine
end