× The internal search function is temporarily non-functional. The current search engine is no longer viable and we are researching alternatives.
As a stop gap measure, we are using Google's custom search engine service.
If you know of an easy to use, open source, search engine ... please contact support@midrange.com.



I've seen his work before as well.
Normally, I take the examples and fiddle with it to learn how the stuff works. Then, I take that experimentation and write a program to do what I need with the example as a reference.

I suspect it might be the 7.1 system. The service program is not one I've seen referenced before.


On 12/30/2021 4:45 PM Scott Klement <rpg400-l@xxxxxxxxxxxxxxxx> wrote:


Hi Jay,

On 12/30/2021 12:48 PM, Jay wrote:
I've wasted most of the morning trying to get a call to QSYLOBJA to work.
Does anyone have a working example??
I found an example from someone named Carsten, but it won't compile as it is looking for a service program QDMM.. something.

You didn't say what you needed the example to do, or what problem you
were having...  so hard to know if my reply will help you.

I do know Carsten's work, though -- it is always well-written and
tested, so I'm very surprised to hear that you had problems with it. 
QSYLOBJA is an OPM program, so doesn't (and can't) use service
programs.  Something weird is going on...

I have an old example of QSYLOBJA laying around (it's very old, looks
like 2003, please excuse the outdated coding style).  I don't remember
writing it anymore, but it looks like it was intended to illustrate the
process of sorting the output of an API...

     H DFTACTGRP(*NO) ACTGRP(*NEW) BNDDIR('QC2LE')

     D QSYLOBJA        PR                  ExtPgm('QSYLOBJA')
     D   UsrSpc                      20A   const
     D   Format                       8A   const
     D   User                        10A   const
     D   ObjType                     10A   const
     D   RtnObjs                     10A   const
     D   ContHandle                  20A   const
     D   ErrorCode                32766A   options(*varsize)
     D   ReqList                  32766A   options(*varsize: *nopass)

     D QUSCRTUS        PR                  ExtPgm('QUSCRTUS')
     D   UsrSpc                      20A   CONST
     D   ExtAttr                     10A   CONST
     D   InitialSize                 10I 0 CONST
     D   InitialVal                   1A   CONST
     D   PublicAuth                  10A   CONST
     D   Text                        50A   CONST
     D   Replace                     10A   CONST
     D   ErrorCode                32766A   options(*nopass: *varsize)

     D QUSPTRUS        PR                  ExtPgm('QUSPTRUS')
     D   UsrSpc                      20A   CONST
     D   Pointer                       *

     D QUSDLTUS        PR                  ExtPgm('QUSDLTUS')
     D   UsrSpc                      20A   CONST
     D   ErrorCode                32766A   options(*varsize)

     D qsort           PR                  ExtProc('qsort')
     D   start_of_dta                  *   value
     D   num_of_elems                10U 0 value
     D   size_of_elem                10U 0 value
     D   compare_proc                  *   ProcPtr value

     D Compare         PR            10I 0
     d   p_Ent1                        *
     d   p_Ent2                        *

     D p_UsrSpc        s               *
     D dsLH            DS                   BASED(p_UsrSpc)
     D                                      qualified
     D   Filler1                    103A
     D   Status                       1A
     D   Filler2                     12A
     D   HdrOffset                   10I 0
     D   HdrSize                     10I 0
     D   ListOffset                  10I 0
     D   ListSize                    10I 0
     D   NumEntries                  10I 0
     D   EntrySize                   10I 0

     D p_OO            s               *
     D dsOO            ds                  based(p_OO) qualified
     D   PathOffset                  10I 0
     D   PathLen                     10I 0
     d   ObjType                     10A
     d   AuthHolder                   1A
     D   Ownership                    1A
     D   ASPDevice                   10A

      **
      ** FIXME: This will cause problems if a user has more than
      **        32k objects, but it makes the code simpler :)
      **        If you need more, just allocate a block of memory
      **        and use pointer math.
     D p_SortList      s               *
     D SortList        s               *   dim(32767) based(p_SortList)

     D p_Path          s               *
     D dsPath          ds                  based(p_Path) qualified
     D   CCSID                       10I 0
     D   Country                      2A
     D   LangID                       3A
     D   Reserved1                    3A
     D   Flag                        10I 0
     D   len                         10I 0
     D   Delim                        2A
     D   Reserved2                   10A
     D   Name                     32768A

     D dsEC            DS                  qualified
     D  BytesProvided                10I 0 inz(%size(dsEC))
     D  BytesAvail                   10I 0 inz(0)
     D  MessageID                     7A
     D  Reserved                      1A
     D  MessageData                 240A

     D MYSPACE         C                   CONST('OWNLIST QTEMP     ')
     D size            s             10I 0
     D msg             s             52A
     D x               s             10I 0

      /free

         //
         // set this to zero to let OS/400 handle errors, instead
         //  of handling them ourselves...
         //
         dsEC.BytesProvided = 0;

         //
         // Create a user space.. make space for (approx) 1000
         //  IFS objects to be listed.
         //
         size = %size(dsLH) + 512 + ((%size(dsOO) + 100) * 1000);
         QUSCRTUS(MYSPACE: 'USRSPC': size: x'00': '*ALL':
                 'Temp User Space for QSYLOBJA API':  '*YES': dsEC);

         //
         //  List objects owned by current user to the user space
         //
         QSYLOBJA(MYSPACE: 'OBJA0110': '*CURRENT': '*ALL': '*OBJOWN':
                  *BLANKS: dsEC);

         QUSPTRUS(MYSPACE: p_UsrSpc);


         //
         // Populate an array of pointers, each pointer pointing
         // to a user space entry.
         //
         size = %size(p_OO) * dsLH.NumEntries;
         p_SortList = %alloc(size);
         p_OO = p_UsrSpc + dsLH.ListOffset;
         for x = 1 to dsLH.NumEntries;
             SortList(x) = p_OO;
             p_OO = p_UsrSpc + (dsOO.PathOffset + dsOO.PathLen);
         endfor;

         //
         // sort the array.  The interesting part about this sort is
         //  in the COMPARE procedure below.
         //
         qsort(p_SortList: dsLH.NumEntries: %size(p_OO):
%paddr('COMPARE'));

         //
         // display the sorted array
         //
         for x = 1 to dsLH.NumEntries;
            p_OO = SortList(x);
            p_Path = p_UsrSpc + dsOO.PathOffset;
            msg = %subst(dsPath.Name: 1: dsPath.Len);
            dsply msg;
         endfor;

         dealloc p_SortList;
         QUSDLTUS(MYSPACE: dsEC);

         *inlr = *on;
      /end-free


*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      *  qsort() calls this routine to tell when one entry is
      *         greater or less than another.
      *
      *  FIXME: Comparison is only done on the first 32k of the
      *         Pathname.  To work with larger pathnames, this
      *         could be changed to use memcmp().
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
     P Compare         B                   export
     D Compare         PI            10I 0
     d   p_Ent1                        *
     d   p_Ent2                        *

     D Ent1            ds                  likeds(dsOO) based(p_Ent1)
     D Ent2            ds                  likeds(dsOO) based(p_Ent2)

     D p_Path1         s               *
     D Path1           ds                  likeds(dsPath) based(p_Path1)
     D p_Path2         s               *
     D Path2           ds                  likeds(dsPath) based(p_Path2)

      /free
         p_path1 = p_UsrSpc + Ent1.PathOffset;
         p_Path2 = p_UsrSpc + Ent2.PathOffset;

         if %subst(Path1.Name: 1: Path1.Len)
              < %subst(Path2.Name: 1: Path2.Len);
           return -1;
         elseif %subst(Path1.Name: 1: Path1.Len)
              > %subst(Path2.Name: 1: Path2.Len);
           return 1;
         else;
           return 0;
         endif;

      /end-free
     P                 E

--
This is the RPG programming on IBM i (RPG400-L) mailing list
To post a message email: RPG400-L@xxxxxxxxxxxxxxxxxx
To subscribe, unsubscribe, or change list options,
visit: https://lists.midrange.com/mailman/listinfo/rpg400-l
or email: RPG400-L-request@xxxxxxxxxxxxxxxxxx
Before posting, please take a moment to review the archives
at https://archive.midrange.com/rpg400-l.

Please contact support@xxxxxxxxxxxxxxxxxxxx for any subscription related questions.

Help support midrange.com by shopping at amazon.com with our affiliate link: https://amazon.midrange.com

As an Amazon Associate we earn from qualifying purchases.

This thread ...

Replies:

Follow On AppleNews
Return to Archive home page | Return to MIDRANGE.COM home page

This mailing list archive is Copyright 1997-2024 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].

Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.