midrange.com code scratchpad
Name:
UUID
Scriptlanguage:
Plain Text
Tabwidth:
4
Date:
05/29/2012 03:51:17 pm
IP:
Logged
Description:
Generate UUID and return as human-readable text.
Src: http://blackrobes.net/code/ile-rpg-uuid-functions
Code:
  1. getUUID prototype:
  2. //////// remove this line
  3.      d getUUID         pr            16a
  4.  
  5. getUUID procedure:
  6. //////// remove this line
  7.      p getUUID         b
  8.      d getUUID         pi            16a
  9.       // Implements DCE version 1 UUID
  10.       // Source link:
  11.       // http://publib.boulder.ibm.com/iseries/v5r1/ic2924/tstudio/tech_ref/mi/GENUUID.htm
  12.       // Template structure required for _GENUUID.
  13.      d UUID_template   ds
  14.      d  UUID_bytes_provided...
  15.      d                               10u 0 inz(%size(uuid_template))
  16.      d  UUID_bytes_available...
  17.      d                               10u 0
  18.      d  UUID_reserved                 8a   inz(*allx'00')
  19.      d  UUID_UUID                    16a
  20.      d GenUUID         pr                  extproc('_GENUUID')
  21.      d  UUID_Template                  *   value
  22.       /free
  23.          reset uuid_template;
  24.          GenUUID(%addr(UUID_Template));
  25.          return UUID_UUID;
  26.       /end-free
  27.      p getUUID         e
  28.  
  29.  
  30. getUUIDstring prototype:
  31. //////// remove this line
  32.      d getUUIDString   pr            36a
  33.      d  inUUID                       16a   options(*nopass)
  34.  
  35.  
  36. getUUIDstring procedure:
  37. //////// remove this line
  38.      p getUUIDString   b
  39.      d getUUIDString   pi            36a
  40.      d  inUUID                       16a   options(*nopass)
  41.      d workuuid        s                   inz like(inuuid)
  42.      d uuid_string     s             36a   inz
  43.       // Convert hex to character API.
  44.      d cvthc           pr                  extproc('cvthc')
  45.      d  Result                    65534a   options(*varsize)
  46.      d  Source                    32767a   options(*varsize)
  47.      d  ResultSize                   10i 0 value
  48.       // NLS convert case.
  49.      d convertcase     pr                  extproc('QlgConvertCase')
  50.      d  ctrlBlock                          const like(FRCB)
  51.      d  inString                  65535a   const options(*varsize)
  52.      d  outString                 65535a   options(*varsize)
  53.      d  inLength                     10i 0 const
  54.      d  apiErrorDS                  300a   options(*varsize)
  55.       // Formatted request control block required by QlgConvertCase.
  56.      d FRCB            ds                  qualified
  57.      d  ReqType                      10i 0 inz(1)
  58.      d  CCSID                        10i 0 inz(0)
  59.      d  CvtTo                        10i 0 inz(0)
  60.      d  Reserved                     10a   inz(*allx'00')
  61.       // Helper constants for FRCB.
  62.       // Uses request 1 (CCSID format): assumes lower case, job CCSID.
  63.       // For more information about the control block, see:
  64.       // http://publib.boulder.ibm.com/infocenter/iseries/v5r3/topic/apis/QLGCNVCS.htm
  65.      d CvtToUpper      c                   0
  66.      d CvtToLower      c                   1
  67.       // Error code structure.
  68.      d errc0100        ds
  69.      d  errc01bytpro                 10i 0 inz(%size(errc0100))
  70.      d  errc01bytava                 10i 0 inz
  71.      d  errc01excid                   7a   inz
  72.      d  errc01resaaa                  1a   inz(x'00')
  73.      d  errc01excdta                250a   inz
  74.       /free
  75.          if %parms() = 1;
  76.             workuuid = inuuid;
  77.          else;
  78.             workuuid = getuuid();
  79.          endif;
  80.          cvthc( uuid_string : workuuid : %len(workuuid)*2 );
  81.          frcb.cvtto = cvttolower;
  82.          reset errc0100;
  83.          convertcase( frcb : uuid_string : uuid_string :
  84.                       %len(uuid_string) : errc0100 );
  85.          uuid_string = %subst(uuid_string:1:8) + '-' +
  86.                        %subst(uuid_string:9:4) + '-' +
  87.                        %subst(uuid_string:13:4) + '-' +
  88.                        %subst(uuid_string:17:4) + '-' +
  89.                        %subst(uuid_string:21:12);
  90.          return uuid_string;
  91.       /end-free
  92.      p getUUIDString   e
  93.  
  94.  
© 2004-2019 by midrange.com generated in 0.004s valid xhtml & css