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:
- getUUID prototype:
- //////// remove this line
- d getUUID pr 16a
-
- getUUID procedure:
- //////// remove this line
- p getUUID b
- d getUUID pi 16a
- // Implements DCE version 1 UUID
- // Source link:
- // http://publib.boulder.ibm.com/iseries/v5r1/ic2924/tstudio/tech_ref/mi/GENUUID.htm
- // Template structure required for _GENUUID.
- d UUID_template ds
- d UUID_bytes_provided...
- d 10u 0 inz(%size(uuid_template))
- d UUID_bytes_available...
- d 10u 0
- d UUID_reserved 8a inz(*allx'00')
- d UUID_UUID 16a
- d GenUUID pr extproc('_GENUUID')
- d UUID_Template * value
- /free
- reset uuid_template;
- GenUUID(%addr(UUID_Template));
- return UUID_UUID;
- /end-free
- p getUUID e
-
-
- getUUIDstring prototype:
- //////// remove this line
- d getUUIDString pr 36a
- d inUUID 16a options(*nopass)
-
-
- getUUIDstring procedure:
- //////// remove this line
- p getUUIDString b
- d getUUIDString pi 36a
- d inUUID 16a options(*nopass)
- d workuuid s inz like(inuuid)
- d uuid_string s 36a inz
- // Convert hex to character API.
- d cvthc pr extproc('cvthc')
- d Result 65534a options(*varsize)
- d Source 32767a options(*varsize)
- d ResultSize 10i 0 value
- // NLS convert case.
- d convertcase pr extproc('QlgConvertCase')
- d ctrlBlock const like(FRCB)
- d inString 65535a const options(*varsize)
- d outString 65535a options(*varsize)
- d inLength 10i 0 const
- d apiErrorDS 300a options(*varsize)
- // Formatted request control block required by QlgConvertCase.
- d FRCB ds qualified
- d ReqType 10i 0 inz(1)
- d CCSID 10i 0 inz(0)
- d CvtTo 10i 0 inz(0)
- d Reserved 10a inz(*allx'00')
- // Helper constants for FRCB.
- // Uses request 1 (CCSID format): assumes lower case, job CCSID.
- // For more information about the control block, see:
- // http://publib.boulder.ibm.com/infocenter/iseries/v5r3/topic/apis/QLGCNVCS.htm
- d CvtToUpper c 0
- d CvtToLower c 1
- // Error code structure.
- d errc0100 ds
- d errc01bytpro 10i 0 inz(%size(errc0100))
- d errc01bytava 10i 0 inz
- d errc01excid 7a inz
- d errc01resaaa 1a inz(x'00')
- d errc01excdta 250a inz
- /free
- if %parms() = 1;
- workuuid = inuuid;
- else;
- workuuid = getuuid();
- endif;
- cvthc( uuid_string : workuuid : %len(workuuid)*2 );
- frcb.cvtto = cvttolower;
- reset errc0100;
- convertcase( frcb : uuid_string : uuid_string :
- %len(uuid_string) : errc0100 );
- uuid_string = %subst(uuid_string:1:8) + '-' +
- %subst(uuid_string:9:4) + '-' +
- %subst(uuid_string:13:4) + '-' +
- %subst(uuid_string:17:4) + '-' +
- %subst(uuid_string:21:12);
- return uuid_string;
- /end-free
- p getUUIDString e
-
-
|
|
|