====== Check Object Lock ======

<sxh>
**FREE

ctl-opt dftactgrp(*no) actgrp(*caller) bnddir('MYBNDDIR');


/include '/usr/local/include/llist/llist_h.rpgle'
/include '/usr/local/include/llist/lutil_h.rpgle'
/include '/usr/local/include/libc_h.rpgle'
/include '/usr/local/include/system_h.rpgle'
/include '/usr/local/include/userspace_h.rpgle'

dcl-pr system_listObjectLocks extpgm('QWCLOBJL');
  qualUsName char(20) const;
  format char(8) const;
  qualObjName char(20) const;
  objectType char(10) const;
  memberName char(10) const;
  errorCode likeds(qusec_t);
end-pr;

dcl-ds object_t qualified template;
  name char(10);
  library char(10);
  type char(10);
end-ds;

dcl-pi *n;
  file char(10) const;
end-pi;

if (%addr(file) <> *null and file <> *blank);
  main();
else;
  dsply 'no file passed';
endif;

*inlr = *on;


dcl-proc main;
  dcl-s abnormallyEnded ind;
  dcl-s objects pointer;
  dcl-s value char(50);
  dcl-ds object likeds(object_t) based(entry);
  dcl-s lockCount int(10);

  objects = lutil_listObjects('*ALL' : file : '*FILE');

  entry = list_iterate(objects);
  dow (entry <> *null);
    value = %str(entry);

    if (isLocked(object));
      dsply %trimr(object + ' is locked');
      lockCount += 1;
    endif;


    entry = list_iterate(objects);
  enddo;

  if (lockCount = 0);
    dsply 'Alle Objekte sind nicht gesperrt.';
  endif;

  on-exit abnormallyEnded;
    if (objects <> *null);
      list_dispose(objects);
    endif;
end-proc;


dcl-proc isLocked;
  dcl-pi *n ind;
    object likeds(object_t) const;
  end-pi;

  dcl-s abnormallyEnded ind;
  dcl-s usName char(10);
  dcl-s usLib char(10) inz('QTEMP');
  dcl-ds errorCode likeds(qusec_t);
  dcl-ds userspaceHeader qualified based(usPtr);
    userArea       char(64);
    headerSize     int(10);
    releaseLevel   char(4);
    formatName     char(8);
    apiUsed        char(10);
    dateCreated    char(13);
    infoStatus     char(1);
    usSizeUsed     int(10);
    offsetInput    int(10);
    sizeInput      int(10);
    offsetHeader   int(10);
    headerSecSiz   int(10);
    offsetList     int(10);
    listSecSize    int(10);
    nmbrEntries    int(10);
    entrySize      int(10);
    entryCCSID     int(10);
    regionID       char(2);
    langID         char(3);
    subListInd     char(1);
    us_gen_reser   char(42);
  end-ds;

  clear errorCode;
  usName = %subst(%str(tmpnam(*omit)) : 7);

  userspace_create(usName + usLib : '' : 64000 : x'00' : '*ALL' : 'Test object lock');

  clear errorCode;
  system_listObjectLocks(usName + usLib : 'OBJL0100' :
      object.name + object.library : '*FILE' : '*NONE' : errorCode);

  userspace_retrievePointer(usName + usLib : usPtr);

  return userspaceHeader.nmbrEntries > 0;

  on-exit abnormallyEnded;
    userspace_delete(usName + usLib : errorCode);
end-proc;
</sxh>



{{tag>devel ibm rpg}}