project BLF > class Persistence (Progress) > method AuditEnable

Description

For all connected databases that are enabled for auditing use the provided client principal object to set a client user ID for auditing.


Parameters


ihClientPrincipalinputhandle
oiReturnStatusoutputintegerReturn status of the method.


Internal usage


unused


program code (program1/progress.p)

do vidx = 1 to num-dbs:

    if  dbtype(vidx) = "PROGRESS"
    and audit-enabled(vidx)
    then do:
        vcDB        = ldbname(vidx) + "._db".
        vcDBoption  = ldbname(vidx) + "._db-option".
        vlIsEnabled = no.
        create query vhQuery in widget-pool "non-persistent".
        vhQuery:forward-only = yes.
        create buffer vhDB for table vcDB in widget-pool "non-persistent".
        create buffer vhDBoption for table vcDBoption in widget-pool "non-persistent".
        vhQuery:set-buffers(vhDB,vhDBoption).
        vhQuery:query-prepare("for each " + vcDB
                        + " where _Db-local=yes,"
                        + " first " + vcDBoption + " of " + vcDB
                        + " where _db-option-type = 2"
                        + " and _db-option-code = '_pvm.useAppRegistry'").
        vhQuery:query-open.
        do while true:
            vhQuery:get-next(no-lock).
            if vhQuery:query-off-end then leave.               
            if vhDBoption::_Db-option-value = 'yes'
            then do:
                vlIsEnabled = yes.
                leave.
            end.
        end.
        vhQuery:query-close.
        delete object vhQuery.
        delete object vhDB.
        delete object vhDBoption.
        
        if vlIsEnabled
        then vlIsEnabled = set-db-client (ihClientPrincipal,vidx) no-error.
        
        if vlIsEnabled = no
        then do:
            oiReturnStatus = 1.
            <M-1 run ErrorMessage
               (input  #T-1'The database $1 is audit-enabled, but the 'Trust Application Domain Registry' option isn't set on.':255(5181)T-1# (icMessage), 
                input  ldbname(vidx) (icArguments), 
                input  '' (icFieldName), 
                input  '' (icFieldValue), 
                input  '' (icRowid), 
                input  ? (ihClass)) in Progress>
            return.
        end.
    end.
end.