如何於 CL 中產生 UUID ?(Command GENUUID with MI GENUUID)
How to Generate UUID in CL ? (Command GENUUID with MI GENUUID)
File : QCLSRC
Member: GENUUIDC
Type : CLLE
/* */
/* \\\\\\\ */
/* ( o o ) */
/*------------------------oOO----(_)----OOo-----------------------*/
/* */
/* Program : GENUUIDC */
/* System : IBM i V7R2 */
/* Author : Vengoal Chang */
/* Date : 2023/11/10 */
/* Description : Generate Universal Unique Identifier (GENUUID)*/
/* GENUUID command CPP */
/* */
/* ooooO Ooooo */
/* ( ) ( ) */
/*----------------------( )-------------( )-------------------*/
/* (_) (_) */
/* */
/* */
/* To compile : */
/* The source type must be "CLLE" (and not CLP). */
/* Compile with STRPDM option 14 or use the */
/* CRTBNDCL command. */
/* */
/*----------------------------------------------------------------*/
Pgm Parm(&UUIDP &UUIDHEX)
Dcl &UUIDP *Char 16
Dcl &UUIDHEX *Char 32
Dcl &TMPL *Char 32
Dcl &LEN *Uint 4 VALUE(32)
Dcl &BytPrv *Uint Stg(*DEFINED) +
Len(4) DefVar(&TMPL)
Dcl &BytAvl *Uint Stg(*DEFINED) +
Len(4) DefVar(&TMPL)
Dcl &Reserved *Char Stg(*DEFINED) +
Len(8) DefVar(&TMPL 10)
Dcl &UUID *Char Stg(*DEFINED) +
Len(16) DefVar(&TMPL 17)
Dcl &RcvHexLen *Int 4 32
CallPrc Prc('_PROPB') Parm((&TMPL *ByRef) +
(X'00' *ByVal) +
(&LEN *ByVal))
ChgVar &BytPrv 32
CallPrc Prc('_GENUUID') Parm((&TMPL *ByRef))
ChgVar &UUIDP &UUID
CallPrc PRC('cvthc') +
PARM((&UUIDHEX *ByRef) +
(&UUID *ByRef) +
(&RcvHexLen *ByVal))
/* DmpClPgm */
End: EndPgm
File : QCMDSRC
Member: GENUUID
Type : CMD
/*****************************************************************/
/* */
/* Command name: GenUUID */
/* */
/* Author : Vengoal Chang */
/* */
/* Date written: 2023/11/10 */
/* */
/* Description : Generate Universal Unique Identifier (GENUUID) */
/* */
/* To compile: */
/* CRTCMD CMD( GenUUID ) */
/* PGM( GenUUIDC ) */
/* SRCMBR( GenUUID ) */
/* ALLOW( *Ipgm *Bpgm ) */
/* */
/*****************************************************************/
Cmd Prompt('Generate Universal Unique ID')
Parm Kwd( UUID ) +
Type(*CHAR) +
Len(16) +
RtnVal(*YES) +
Prompt('CL var for UUID (16)')
Parm Kwd( UUIDHEX ) +
Type(*CHAR) +
Len(32) +
RtnVal(*YES) +
Prompt('CL var for UUID HEX STR (32)')
星期五, 11月 10, 2023
2023-11-10 如何於 CL 中產生 UUID ?(Command GENUUID with MI GENUUID)
星期四, 11月 09, 2023
2013-07-01 要如何於 SQL 中取用 UUID？(SQL UDF GENSYSUUID)
要如何於 SQL 中取用 UUID？(SQL UDF GENSYSUUID)
AS400 DB2 SQL 並不支援直接取用 UUID，而是須透過呼叫系統函式 _GENUUID 來產生，
下述 SQL UDF GENSYSUUID，產生 UUID (16 bytes)的 16 進位字串(32 bytes)，提供直接於 SQL 中直接取用 UUID。
File : QRPGLESRC
Member: GENSYSUUID
Type : RPGLE
Usage : CRTBNDRPG GENSYSUUID
**
** Program . . : GENSYSUUID
** Description : Generate UUID(16 bytes) to HexString(32 bytes)
** Author . . : Vengoal Chang
** Published . : AS400ePaper
** Date . . . : June 26, 2013
**
**
**
** Programmer's notes:
**
** CREATE FUNCTION QGPL.GENSYSUUID ( )
** RETURNS CHAR(32)
** LANGUAGE RPGLE
** SPECIFIC QGPL.GENSYSUUID
** NOT DETERMINISTIC
** NO SQL
** CALLED ON NULL INPUT
** EXTERNAL NAME 'QGPL/GENSYSUUID'
** PARAMETER STYLE SQL ;
**
** Run STRSQL:
** Select GENSYSUUID ( ) from sysIBM.sysdummy1
**
** CREATE TABLE QGPL/LICENSE (
** KEYUUID CHAR (32 ) NOT NULL,
** CUSTNAME VARCHAR (32 ) NOT NULL WITH DEFAULT,
** PRODUCT VARCHAR (32 ) NOT NULL WITH DEFAULT )
**
** CREATE TRIGGER QGPL.LICENSE_BI BEFORE INSERT ON QGPL.LICENSE
** REFERENCING NEW N FOR EACH ROW MODE DB2ROW
** SET N.KETUUID = QGPL.GENSYSUUID();
**
** INSERT INTO license(custname, product) VALUES('Oracle', 'DB2')
** select * from qgpl/license
**
**
H Option( *NoSrcStmt ) DftActGrp( *No )
H Debug
**
*
* MI builtin to create a hex dump of a spot in memory
*
D hexdump PR EXTPROC('cvthc')
D output 32A
D input 16A
D output_len 10I 0 value
D HexUUID S 32A
D UUID_template Ds
D UtBytPrv 10u 0 Inz( %Size( UUID_template ))
D UtBytAvl 10u 0
D 8a Inz( *Allx'00' )
D UUID 16a
**
D GenUuid PR ExtProc('_GENUUID')
D UUID_template * Value
D pRtnUUID S 32
D pRtnUUIDIn S 5I 0
D sqlstate S 5A
d functname S 517A VARYING
d specname S 128A VARYING
d errormsg S 70A VARYING
**
C *Entry Plist
C Parm pRtnUUID
C Parm pRtnUUIDIn
C Parm sqlstate
C Parm functname
C Parm specname
C Parm errormsg
C Callp GenUuid( %Addr( UUID_template ))
C Callp HexDump( HexUUID :
C UUID :
C %size(HexUUID)
C )
C Eval pRtnUUID = HexUUID
C* dump
**
C Return
參考資訊:
Generate Universal Unique Identifier (GENUUID)
星期三, 11月 08, 2023
2009-12-07 如何產生 SHA1 的檢查碼？
如何產生 SHA1 的檢查碼？
由於一般計算 MD5 或 SHA1 檢查碼均是以 ASCII 型態計算，要於 AS/400 EBCDIC 編碼下計算，均須呼叫轉碼
API QTQCVRT 先將 AS/400 EBCDIC 轉換為 ASCII 編碼，再以 ASCII 值取得檢查碼。
SHA1 檢查碼 20 byte 長，轉換為 16 進位顯示為 40 位長。
MD5 檢查碼 16 byte 長，轉換為 16 進位顯示為 32 位長。
File : QRPGLESRC
Member: SHA1R
Type : RPGLE
OS version:
Usage : CRTRPGBND (xxx/SHA1R)
* The SHA1 Algorithm
* http://php.net/manual/en/function.sha1.php
* ascii 'apple'
* SHA1= d0be2dc421be4fcd0172e5afceea3970e2f3d940
H DFTACTGRP(*NO) ACTGRP('QILE') BNDDIR('QC2LE')
DCipher PR EXTPROC('_CIPHER')
D * VALUE
D * VALUE
D * VALUE
DConvert PR EXTPROC('_XLATEB')
D * VALUE
D * VALUE
D 10u 0 VALUE
Dcvthc PR EXTPROC('cvthc')
D 1
D 1
D 10i 0 VALUE
DControls DS
D Function 5i 0 inz(5)
D HashAlg 1 inz(x'01')
D Sequence 1 inz(x'00')
D DataLngth 10i 0 inz(15)
D Unused 8 inz(*LOVAL)
D HashCtxPtr * inz(%addr(HashWorkArea))
DHashWorkArea S 96 inz(*LOVAL)
DMsg S 50
DReceiverHex S 20
DReceiverPtr S * inz(%addr(ReceiverHex))
DReceiverChr S 40
DSourcePtr S * inz(%addr(Msg))
DStartMap s 256
DTo819 s 256
DCCSID1 s 10i 0 inz(37)
DST1 s 10i 0 inz(0)
DL1 s 10i 0 inz(%size(StartMap))
DCCSID2 s 10i 0 inz(819)
DST2 s 10i 0 inz(0)
DGCCASN s 10i 0 inz(0)
DL2 s 10i 0 inz(%size(To819))
DL3 s 10i 0
DL4 s 10i 0
DFB s 12
D ds
D x 5i 0
D LowX 2 2
D* Get all single byte ebcdic hex values
C 0 do 255 x
C eval %subst(StartMap:x+1:1) = LowX
C enddo
C* Get conversion table for 819 from 37
C call 'QTQCVRT'
C parm CCSID1
C parm ST1
C parm StartMap
C parm L1
C parm CCSID2
C parm ST2
C parm GCCASN
C parm L2
C parm To819
C parm L3
C parm L4
C parm FB
C* Set message text
C eval Msg = 'apple'
C eval DataLngth = %len(%trimr(Msg))
C* Now Change Msg to 819 from 37 using MI
C callp Convert( %addr(Msg)
C :%addr(To819)
C :%size(Msg))
C* Get MD5 for Msg
C callp Cipher( %addr(ReceiverPtr)
C :%addr(Controls)
C :%addr(SourcePtr))
C* Convert nibbles to characters
C callp cvthc( ReceiverChr
C :ReceiverHex
C :%size(ReceiverChr))
C* Display the ascii "apple"
* SHA1= d0be2dc421be4fcd0172e5afceea3970e2f3d940
C ReceiverChr dsply
C eval *INLR = '1'
C return
2008-06-20 如何判斷 AS/400 主機有幾顆 CPU ? (DSPCPUCNT with MI _MATMATR1)
如何判斷 AS/400 主機有幾顆 CPU ? (DSPCPUCNT with MI _MATMATR1)
File : QRPGLESRC
Member: DSPCPUCNT
Type : RPGLE
Usage : CRTBNDRPG DSPCPUCNT
CALL DSPCPUCNT
OS Version: V5R1
H DEBUG OPTION(*SRCSTMT:*NODEBUGIO) DFTACTGRP(*NO) ACTGRP(*CALLER)
D GetCPUCount PR 10U 0 EXTPROC('GETCPUCOUNT')
**-- Send program message:
D SndPgmMsg Pr ExtPgm( 'QMHSNDPM' )
D SpMsgId 7a Const
D SpMsgFq 20a Const
D SpMsgDta 128a Const
D SpMsgDtaLen 10i 0 Const
D SpMsgTyp 10a Const
D SpCalStkE 10a Const Options( *VarSize )
D SpCalStkCtr 10i 0 Const
D SpMsgKey 4a
D SpError 32767a Options( *VarSize )
**-- Send completion message:
D SndCmpMsg Pr 10i 0
D PxMsgDta 512a Const Varying
**-- API error data structure:
D ERRC0100 Ds Qualified
D BytPrv 10i 0 Inz( %Size( ERRC0100 ))
D BytAvl 10i 0
D MsgId 7a
D 1a
D MsgDta 128a
D CPU_Count S 5U 0
C eval *InLr = *On
C eval CPU_Count = GetCPUCount()
C callp SndCmpMsg(
C %editC(CPU_Count : '4') +
C ' CPUs detected.'
C )
C return
*=====================================================================
* Get CPU count with MI _MATMATR1 option X'01DC'
*=====================================================================
P GetCPUCount B Export
D GetCPUCount PI 10U 0
D matmatr PR extProc('_MATMATR1')
D MMTR_T 256A options(*VARSIZE)
D nOption 5I 0 Const
D CPU_Count DS Inz Qualified
D nSize 10I 0 inz(%Size(CPU_COUNT))
D nBytesRtn 10I 0
D count 5U 0
D processor_cnt C Const(X'01DC')
C callP matmatr(cpu_count : processor_cnt)
C return cpu_count.count
P GetCPUCount E
**-- Send completion message: ------------------------------------------**
P SndCmpMsg B
D Pi 10i 0
D PxMsgDta 512a Const Varying
**
D MsgKey s 4a
C Callp SndPgmMsg( 'CPF9897'
C : 'QCPFMSG *LIBL'
C : PxMsgDta
C : %Len( PxMsgDta )
C : '*COMP'
C : '*PGMBDY'
C : 1
C : MsgKey
C : ERRC0100
C )
C If ERRC0100.BytAvl > *Zero
C Return -1
C Else
C Return 0
C EndIf
**
P SndCmpMsg E
星期二, 11月 07, 2023
2006-10-11 如何判斷 Job 是 interactive 或 batch(CL command RTVJOBA, API QUSRJOBI, or MI _PCOPTR) ?
如何判斷 Job 是 interactive 或 batch(CL command RTVJOBA, API QUSRJOBI, or MI _PCOPTR) ?
可以使用 CL command RTVJOBA TYPE(&TYPE)
IF (&TYPE *EQ '1') ==> batch(批次)
If (&TYPE *EQ '0') ==> interactive(線上)
或使用 2001-02-06 如何於ＲＰＧ中判斷 Batch 或 Interactive Job -- INTERACTR(API QUSRJOBI)
請至 http://blog.xuite.net/vengoal/as400 Vengoal 日誌瀏覽
或是用本期電子報所提供更快速的系統內建函數(machine interface) _PCOPTR
File : QRPGLESRC
Member: RTVJOBTYPE
Type : RPGLE
Usage : CRTBNDRPG RTVJOBTYPE
CALL RTVJOBTYPER
==> DSPLY I (表示 interactive 線上)
SBMJOB CMD(CALL RTVJOBTYPE)
==> DSPMSG QSYSOPR
會出現 DSPLY B 訊息(表示 batch 批次)
OS version: 適用於V5R1(含)以後
H dftactgrp( *no ) debug
D PCOPTR PR * extproc( '_PCOPTR' )
D Pco DS based( Pco@ ) qualified
D JobType 1A overlay( Pco: 545 )
C eval Pco@ = PCOPTR()
C* show "I" or "B"
C Pco.JobType dsply
C eval *INLR = *on
2006-02-23 如何檢查 UPS 連接狀況 ?
如何檢查 UPS 連接狀況 ?
利用 System MI _MATMATR1 取得 UPS 狀態.
File : QRPGLESRC
Member: RTVUPSINF
Type : RPGLE
Usage : CRTBNDRPG PGM(RTVUPSINF)
由於是RPG free 格式所以需要 OS V5R1 以上才可以編譯, 可自行修改為 RPG 固定格式
**
** Program . . : CBX512
** Description : Retrieve UPS information
** Author . . : Carsten Flensburg
**
**
** Program summary
** ---------------
**
** _MATMATR1 Materialize machine Retrieves a broad range of system
** attributes software and hardware related
** attributes.
**
** C library function:
** tstbts Test bits Tests the bit value of the bit
** located with the bit offset
** parameter, bit 0 being the
** leftmost and 64k the maximum.
**
** CrtRpgMod Module( CBX512 )
** DbgView( *LIST )
**
** CrtPgm Pgm( CBX512 )
** Module( CBX512 )
** ActGrp( QILE )
**
**
**-- Header Specifications: --------------------------------------------**
H Option( *SrcStmt ) BndDir( 'QC2LE' ) DecEdit( *JobRun )
H DftActGrp(*NO)
**-- Global constants:
D MMTR_MISR c x'0108'
**-- Global variables:
* 0 = UPS battery not low
* 1 = UPS battery low
D UpsBatLow s n
* 0 = UPS bypass not active
* 1 = UPS bypass active
D UpsBpsAct s n
* 0 = Running on utility power
* 1 = Running on UPS
D UpsPwrRun s n
* 0 = UPS not installed
* 1= UPS installed, ready for use
D UpsInsRdy s n
**-- Inz status record:
D MMTR_0108_T Ds Qualified
D BytPrv 10i 0 Inz( %Size( MMTR_0108_T ))
D BytAvl 10i 0
D MisrSts 6a
**-- Materialize machine attributes:
D MatMatr Pr ExtProc('_MATMATR1')
D Atr 32767a Options( *VarSize )
D Opt 2a Const
**-- Test bit in string:
D tstbts Pr 10i 0 ExtProc( 'tstbts' )
D string * Value
D bitofs 10u 0 Value
/Free
MatMatr( MMTR_0108_T: MMTR_MISR );
If tstbts( %Addr( MMTR_0108_T.MisrSts ): 5 ) = 1;
UpsBatLow = *On;
Else;
UpsBatLow = *Off;
EndIf;
Dsply 'UpsBatLow=';
Dsply UpsBatLow;
If tstbts( %Addr( MMTR_0108_T.MisrSts ): 6 ) = 1;
UpsBpsAct = *On;
Else;
UpsBpsAct = *Off;
EndIf;
Dsply 'UpsBpsAct=';
Dsply UpsBpsAct;
If tstbts( %Addr( MMTR_0108_T.MisrSts ): 7 ) = 1;
UpsPwrRun = *On;
Else;
UpsPwrRun = *Off;
EndIf;
Dsply 'UpsPwrRun=';
Dsply UpsPwrRun;
If tstbts( %Addr( MMTR_0108_T.MisrSts ): 8 ) = 1;
UpsInsRdy = *On;
Else;
UpsInsRdy = *Off;
EndIf;
Dsply 'UpsInsRdy=';
Dsply UpsInsRdy;
*InLr = *On;
Return;
/End-Free
星期三, 11月 01, 2023
2002-04-23 如何於 iSeries(AS/400) 上將資料加密(Data Encryption) ?
如何於 iSeries(AS/400) 上將資料加密(Data Encryption) ?
系統本身僅提供單向資料加密 API _CIPHER
此 API 可應用於 密碼加密後將之存於資料庫中,某些程序需要使用者確認密碼時,輸入之密碼與
先前所儲存的加密密碼比對, 正確時才能進行下一程序. 將重要密碼資料加密,以防止其他人竊
取密碼非法使用. 那你一定會問: "要如何將加密密碼解密?" , 系統 API _CIPHER 並不提供解密
功能, 為的就是防止密碼外洩, 系統僅提供密碼重設(CHGUSRPRF PASSWORD(xxxx)), 若欲要有解密功能則需自行寫程式進行加密及解密或購買 IBM 加密軟體.
下列範例
File : QRPGLESRC
Member: CIPHERR
Type : RPGLE
Usage : CRTBNDRPG PGM(CIPHERR) DFTACTGRP(*NO)
CALL CIPHERR ('1234567890123456' '12345678' ' ')
第一個參數是原始資料且長度必須是 8 的倍數,第二個參數是加密的Key, 第三個參數是加密後的資料, 資料長度須與原始資料長度一樣.
*
* Function 2 -> Encrypt; detail refference SC41-5810 _CIPHER function
* function _CIPHER provides one-way encryption
* Apr. 2002
*
D PlainText S *
D CipherText S *
D Controls DS 32
D Function 5I 0 inz(2)
D Length 5I 0 inz(%size(UserID))
D CBC_Mode 1A inz(X'40')
D SecretKey 1A dim(8)
D Reserved_1 1A inz(*loval)
D InitChain 8A inz(X'5555555555555555')
D Reserved_2 10A inz(*loval)
C *entry plist
C parm UserID 16
C parm Password 8
C parm Encrypted 16
C movea Password SecretKey
C 1 do 8 X 5 0
C testb X'81' SecretKey(X) 21
C 21 biton X'80' SecretKey(X)
C N21 bitoff X'80' SecretKey(X)
C enddo
C eval PlainText = %addr(UserID)
C eval CipherText = %addr(Encrypted)
C callb '_CIPHER'
C parm CipherText
C parm Controls
C parm PlainText
C Encrypted Dsply
C move *on *INLR
2002-02-02 利用 OS/400 MI 函數CvtEFN (Convert External Form to Numeric Value) 將文字性數字轉為數值
利用 OS/400 MI 函數CvtEFN (Convert External Form to Numeric Value) 將文字性數字轉為數值
這個 CvtEFN (Convert External Form to Numeric Value) MI 函數是一個很強的函數，它轉換文字到數值，
實際上文字可包含 "$" "," "." 三個字元，而 CvtEFN 函數將刪除上述三個字元並產生一個數值。
File : QRPGLESRC
Member: STring
Type : RPGLE
* A leading currency symbol (defined by a mask)
* A sign symbol (+ or -), leading or trailing
* Digits (0-9)
* Commas to separate thousands
* A decimal point
* Leading and Trailing blanks
Source for service program String follows.
* ===================================================================
* = Service Program... String =
* = Description....... String routines =
* = =
* = Compile........... CrtRPGMod Module(YourLib/String) =
* = SrcFile(YourLib/YourSrcFile) =
* = CrtSrvPgm SrvPgm(YourLib/String) =
* = Export(*All) =
* ===================================================================
H NoMain
* ===================================================================
* = Prototypes =
* ===================================================================
* -------------------------------------------------------------------
* - CvtCharToNum - Convert character to numeric -
* - -
* - String Input -
* - Number Output -
* - -
* - Return value: Boolean success flag (0 = Success, 1 = Error ) -
* -------------------------------------------------------------------
D CvtCharToNum...
D PR N
D 40 Value
D 30 9
* -------------------------------------------------------------------
* - CvtExtFrmToNum - Convert external form to numeric value -
* - -
* - Receiver variable Output -
* - Receiver attributes Input -
* - Source string Input -
* - Source string length Input -
* - Symbol mask Input -
* -------------------------------------------------------------------
D CvtExtFrmToNum...
D PR ExtProc( '_CVTEFN' )
D * Value
D 7 Const
D * Value
D 10U 0 Const
D 3 Const
* ===================================================================
* = Procedure..... CvtCharToNum =
* = Description... Covert character to numeric =
* ===================================================================
P CvtCharToNum...
P B Export
D PI N
D String 40 Value
D Number 30 9
* -------------------------------------------------------------------
* - Data definitions -
* -------------------------------------------------------------------
D RcvAttr DS
D Type 1 Inz( X'03' )
D NbrLen 5I 0
D DecPos 3I 0 Overlay( NbrLen: 1 )
D TotDigits 3I 0 Overlay( NbrLen: 2 )
D 10I 0 Inz( *Zero )
D SymbolMask DS
D CurSymbol 1 Inz( '$' )
D ComSymbol 1 Inz( ',' )
D DecPntSymbol 1 Inz( '.' )
* -------------------------------------------------------------------
* - Convert character string to packed numeric format -
* -------------------------------------------------------------------
C Eval DecPos = %DecPos( Number )
C Eval TotDigits = %Len( Number )
C CallP CvtExtFrmToNum(
C %Addr( Number ) :
C RcvAttr :
C %Addr( String ) :
C %Len( %TrimR( String ) ) :
C SymbolMask
C )
C Return *Off
* -------------------------------------------------------------------
* - Return error condition for any error -
* -------------------------------------------------------------------
C *PSSR BegSr
C Return *On
C EndSr
P CvtCharToNum...
P E
File : QRPGLESRC
Member: STringEx
Type : RPGLE
* ===================================================================
* = Program....... StringEx =
* = Description... Example program using CvtCharToNum =
* = =
* = Compile........... CrtRPGMod Module(YourLib/StringEx) =
* = SrcFile(YourLib/YourSrcFile) =
* = CrtPgm Pgm(YourLib/StringEx) =
* = BndSrvPgm(YourLib/String) =
* ===================================================================
* ===================================================================
* = Prototypes =
* ===================================================================
* -------------------------------------------------------------------
* - CvtCharToNum - Convert character to numeric -
* - -
* - String Input -
* - Number Output -
* - -
* - Return value: Boolean success flag (0 = Success, 1 = Error ) -
* -------------------------------------------------------------------
D CvtCharToNum...
D PR N
D 40 Value
D 30 9
* ===================================================================
* = Definitions =
* ===================================================================
D MyString S 40
D MyNbr S 30 9
D RtnCode S N
* ===================================================================
* = Sample conversions =
* ===================================================================
C Eval MyString = '123,456,789.123456789'
C Eval RtnCode = CvtCharToNum(
C MyString :
C MyNbr
C )
C Eval MyString = '+123,456,789.123456789'
C Eval RtnCode = CvtCharToNum(
C MyString :
C MyNbr
C )
C Eval MyString = '-123,456,789.123456789'
C Eval RtnCode = CvtCharToNum(
C MyString :
C MyNbr
C )
C Eval MyString = '123,456,789.123456789+'
C Eval RtnCode = CvtCharToNum(
C MyString :
C MyNbr
C )
C Eval MyString = '123,456,789.123456789-'
C Eval RtnCode = CvtCharToNum(
C MyString :
C MyNbr
C )
C Eval MyString = '$123,456,789.123456789'
C Eval RtnCode = CvtCharToNum(
C MyString :
C MyNbr
C )
C Eval MyString = '$123,456,789.123456789+'
C Eval RtnCode = CvtCharToNum(
C MyString :
C MyNbr
C )
C Eval MyString = '$123,456,789.123456789-'
C Eval RtnCode = CvtCharToNum(
C MyString :
C MyNbr
C )
* -------------------------------------------------------------------
* - The following conversion fails (RtnCode = 1) due to an embedded -
* - blank -
* -------------------------------------------------------------------
C Eval MyString = '123, 56,789.123456789-'
C Eval RtnCode = CvtCharToNum(
C MyString :
C MyNbr
C )
C Eval *InLR = *On
星期二, 10月 31, 2023
2001-06-20 如何取得程式先後執行的順序(Calling Stack Information)？利用系統函數 _MATINVS2 即可。
如何取得程式先後執行的順序(Calling Stack Information)？利用系統函數 _MATINVS2 即可。
File : QRPGLESRC
Member: CALLSTKR
Type : RPGLE
* The following ILE RPG program reads the invocation stack.
* No need to use MI, a system built-in MATINVS2 does the trick.
* Compile with DFTACTGRP(*NO)
D wPgm s 30
D tmpstr s 52
D wObj ds 60
D wObjLib 30
D wObjPgm 30
D wInvStk ds 32767
D wInvBytPrv 9b 0
D wInvBytAvl 9b 0
D wInvNbrEnt 9b 0
D wInvMrkCnt 9b 0
D pInvEnt s *
D wInvEnt ds 128 based(pInvEnt)
D 32
D pInvPgm *
D wInvNbr 9b 0
D wInvMec 1
D wInvTyp 1
D wInvMrk 9b 0
D wInvIns 9b 0
D wInvActGrp 9b 0
D wInvSusP *
D MatInvS pr extproc('_MATINVS2')
D xInvStk like(wInvStk)
D*GetPgmName pr 30
D GetPgmName pr 60
D xpPgm *
C callp MatInvS (wInvStk)
C eval pInvEnt = %addr(wInvStk) + 16
C do wInvNbrEnt
C* eval wPgm = GetPgmName (pInvPgm)
C* wPgm dsply
C eval wObj = GetPgmName (pInvPgm)
C eval tmpstr = %trim(wObjLib) + '/' +
C %trim(wObjPgm)
C tmpstr dsply
C eval pInvEnt = pInvEnt + %size(wInvEnt)
C enddo
C eval *inlr = *on
***********************************************************************************************
** Get Program Name, returns blank if domain violation (security level >= 40)
***********************************************************************************************
P GetPgmName b
D pi 60
D xpPgm *
D wMatTmp ds
D wMatBytPrv 9b 0
D wMatBytAvl 9b 0
D wMatPtrTyp 1
D wMatPtrCtxT 1
D wMatPtrCtxST 1
D wMatPtrCtx 30
D wMatPtrObjT 1
D wMatPtrObjST 1
D wMatPtrObj 30
D wMatPtrAut 2
D wMatPtrTgI 2
D wRtnStr s 60
D MatPtr pr extproc('_MATPTR')
D xTemplate like(wMatTmp)
D xPointer *
C callp MatPtr (wMatTmp : xpPgm)
c if wMatBytAvl > 0
C eval wRtnStr = wMatPtrCtx +
C wMatPtrObj
C return wRtnStr
C else
C eval wRtnStr = *blanks
C return wRtnStr
C endif
C *pssr begsr
C return *blanks
C endsr
P GetPgmName e
星期二, 10月 11, 2011
訂閱：
文章 (Atom)