如何讓多部 AS/400(iSeries) 系統間的使用者設定檔(User Profile)同步 ?
如何讓多部 AS/400(iSeries) 系統間的使用者設定檔(User Profile)同步，簡化系
統管理工作？
當您管理電腦系統時（包含 AS/400 iSeries ），有三個動作視您需要記住的，
那就是備份、備份、備份。如果您想晚上睡個好覺，您最好有一個關於資料、程式
及作業系統的備份措施。
但仍然有其他的系統管理議題，例如，如果您有一個重要的應用軟體需要一年 365
天，全天 24 小時不中斷的運作，線上即時複製應用軟體及其資料庫系統將是一個
重要的議題。在今天的資訊服務的運算環境中，系統停機而導致無法對客戶提供服務
是不被接受的。如果您的客戶正在進行交易時，因為您的資訊系統無法及時提供應有
的服務，而被迫中斷正在進行的交易，可以想見，他明天有可能是別人的客戶。因此
，如果遇到災難及系統當機時，您的系統需要能自動切換到另一台伺服器，並繼續執
行，就好像沒事發生一樣。為了要完成讓客戶滿意的目標，您需要找適當的資訊技術
來複製應用軟體、資料及其他系統物件，如使用者設定檔（User profiles）。在
這篇文章中我將討論如何複製使用者設定檔（User profiles）至另一台 iSeries。
使用者設定檔（User profiles）
如何讓各個 AS/400(iSeries) 系統彼此之間有一組相同的使用者，是許多應用軟體
供應商或系統管理人員所面臨的挑戰之一。換句話說，當在提供服務的主要系統增加新
的使用者時，同時主要系統要有一個機制自動增加同一使用者於備份系統中。我們使用
AS/400(iSeries) 系統上二個不同且未經常被使用的功能來完成這個目標，這二個功
能是：程序檢核點(又稱跳出點 exit point)及遠端資料序列(remote data queue)。
在這篇文章中，我們將說明當系統管理人員完成某些動作時，系統能自動使用程序檢核點
(exit point)呼叫一支程式的方法；同時以系統管理人員於系統中新增使用者的動作當
成範例。我們也將說明您如何以遠端資料序列(remote data queue)將資訊自動地從一
個系統傳至另一系統。在範例中，我們也將使用遠端資料序列(remote data queue)將
使用者的資訊自動地從一個系統傳至另一備份系統。
現在開始說明如下：
我們將假設您有兩部 AS/400(iSeries)系統彼此間已也完成相關網路設定，並且已經互
相連接於網路上進行通訊，在這篇文章中我們並不說明相關網路設定的方法您能從網站
http://www.geocities.com/vengoal/ AS/400 初學者手冊中(含APPC與TCP/IP)，取得相關
網路設定的方法。
當在 AS/400(iSeries)系統中複製使用者設定檔（User profiles）的第一個挑戰是
：判斷主要系統中何時新增使用者設定檔，一種方式是，我們可以新增一支程式列出兩個
系統的所有使用者，並比對其中的差異。但這種方式無法做到即時同步更新，所以我們需
要執行一支能即時同步更新更新使用者設定檔的程式，進而達到跨 AS/400(iSeries)系
統間使用者設定檔的同步，這才是這篇文章的主要目的。
我們想要執行這支同步更新使用者設定檔的程式能於新增使用者時，自動完成同步的動作
，很幸運的，系統提供一個程序檢核點(exit point)讓我們能完成這個動作，一個程序
檢核點(exit point)是系統執行某些系統處理程序時，系統會暫停並且呼叫程序檢核點
(exit point)所指定的程式，此程式需要系統管理人員依照自己的需求自行撰寫，而這
支程式稱為程序檢核程式（又稱跳出程式 exit program），表一列出程序檢核程式
（又稱跳出程式 exit program）的部份原始碼，這支程式於主要系統中每次新增使用
者時，會自動地被執行。
您可能會問：我們如何告訴系統執行程序檢核點(exit point)所指定的程式？回答是：
我們需要跟系統註冊相對應動作的程序檢核點(exit point)，我們可以使用下述指令跟
系統註冊新增使用者的程序檢核點(exit point)：
ADDEXITPGM +
EXITPNT(QIBM_QSY_CRT_PROFILE) +
FORMAT(CRTP0100) +
PGMNBR(*LOW) +
PGM(xxx/CRTPRFEXTR)
新增程序檢核程式（又稱跳出程式 exit program）的指令 Add Exit Program
(ADDEXITPGM) 會讓系統知道當新增使用者設定檔時執行範例程式 CRTUSREXTR。
不管您是否了解程序檢核點，系統提供許多的程序檢核點(exit point)供系統人
員使用，包括TCP/IP網路應用軟體的安全控管，使用者設定檔，備份等。如果您想
要知道系統提供哪些程序檢核點(exit point)，僅需要執行 Work with
Registration Information (WRKREGINF)指令，瀏覽所有的程序檢核點
(exit point)，並可直接於畫面上新增或移除程序檢核點(exit point)中所指
定的程序檢核程式（又稱跳出程式 exit program）；您也可以於程序檢核點中指定
多支程序檢核程式（又稱跳出程式 exit program），並使用參數 PGMNBR 指定程式
執行的順序。
在我們的範例中，我們於程序檢核點 QIBM_QSY_CRT_PROFILE(exit point)中指
定一支程序檢核程式(跳出程式 exit program)，這是一個新增使用者設定檔的程序
檢核點(exit point)，我們選擇它是因為我們以新增使用者設定檔的程序當成範例
，當然還有 QSY_DLT_PROFILE 及 QSY_CHG_PROFILE 程序檢核點(exit point)
。您要如何利用這些程序檢核點(exit point)來控制您的系統，完全是您的環境而定
，您可能需要撰寫您自己的程序檢核程式(跳出程式 exit program)供刪除及更改使
用者設定檔使用。
表一僅列出程式的一部份，我們來看看這支程式是如何運作的，
參數 InData 代表系統傳給程序檢核程式(跳出程式 exit program)的資訊，它是
一個 38 個位元的資料結構，這個資料結構的定義，依照不同的程序檢核點有不同的
格式，有關使用者設定檔程序檢核點的詳細格式請參照手冊 System API Reference
SC41-5801-03 Chapter 69. Security Exit Programs。
新增使用者設定檔的程序檢核點 QIBM_QSY_CRT_PROFILE (exit point)
格式 CRTP0100 的資料結構格式如下：
位置 欄位型態及長度 欄位說明
===============|
10進位 16進位|
====== =======| ============ ====================================
0 0 | CHAR(20) Exit point name QIBM_QSY_CRT_PROFILE
20 14 | CHAR(8) Exit point format name CRTP0100
28 1C | CHAR(10) User profile name
在我們的範例中，我們所要擷取的是資料結構中最後 10 位的使用者設定檔名稱，這是
一個重要的資訊，我們呼叫 QSYRUSRI API 時，需要傳使用者設定檔名稱給這個 API
，並傳回該使用者相關的使用者設定檔的資訊，回傳的資訊放入變數 Receiver1 中，
並使用 QSNDDTAQ API 將資訊送至第二部 AS/400(iSeries)中，在本篇文章中會有
詳細說明。
在這個範例中，您會看到這支程式呼叫 QSYRUSRI API 兩次，第一次是要取得回傳資
料的可用長度，因為我們不知道真正回傳資訊的長度，但這個 API(其它的 API 也一
樣)將告訴您回傳資訊的可用長度，接著使用 ALLOC 運算元設定接收變數的長度，第
二次才是依照第一次所取得的長度取回資訊，並放入變數 QSYI0300 中。
QSYRUSRI API 所使用格式 USRI0300 的資料結構格式請參照手冊 System API
Reference SC41-5801-03 Chapter 68. Security APIs。
您可能從手冊中注意到回傳值幾乎包含所有除了使用者密碼之外的使用者設定檔資訊，
所以下一件事，這支程序檢核程式(跳出程式 exit program)需要取得該使用者的密
碼。
您可能會有疑問，”我能獲得使用者的密碼嗎？如果能取得使用者密碼，哪我就能以任
一使用者的代碼及其密碼進入系統。”我不想搓破你的美夢，但這並不像您所想的，您
仍然無法取得使用者的原始密碼，但有一個 QSYRUPWD API 可以取得使用者經過系統
加密過後的密碼，而這個經過加密後的密碼是無法在進入系統(SignOn)畫面上使用的，
這個範例所取得的密碼即是經過系統加密過後的密碼，您無法看到使用者的真正密碼，
所以還是忘了那個美夢吧。唯一所能做的是將取得的加密密碼，傳給 QSYSUPWD API
，這個 API 用來設定同一個使用者的加密密碼，也就是說 QSYRUPWD API 的使用
者設定檔參數值及 QSYSUPWD API UPWD0100 格式中使用者設定檔欄位值要相同。
QSYRUPWD API 及 QSYSUPWD API 的相關詳細資訊參照手冊 System API
Reference SC41-5801-03 Chapter 68. Security APIs。
這支程式呼叫 RtvEncPwd 程序擷取使用者的密碼，這個程序接收使用者設定檔名稱，
同樣呼叫 QSYRUPWD API 二次，然後傳資料結構(加密密碼及使用者設定檔名稱)給呼
叫程式；我們然後將此回傳的資料結構與 QSYRUSRI API 所擷取的使用者設定檔資訊
結合成一個字串，並使用 QSNDDTAQ API 將此合成字串寫入遠端資料序列(remote
data queue)。
現在我們來說明資料序列(data queue)，資料序列所存放的資料是先進先出，而所謂的
遠端資料序列(remote data queue)即是從系統 A 將資料寫入遠端資料序列(remote
data queue)，便可以從另一系統 B 擷取系統 A 所放入的資訊，而系統 A 及 系統 B
可以是不同的 AS/400(iSeries)系統。我們可藉由下述指令建立一個使用 TCP/IP 連線
的遠端資料序列(remote data queue)：
CRTDTAQ +
DTAQ(QGPL/PASSUSER) +
TYPE(*DDM) +
MAXLEN(1000) +
SEQ(*KEYED) +
KEYLEN(4) +
RMTDTAQ(QGPL/PASSUSERRM) +
RMTLOCNAME(RMTNAME)
我們於指令建立資料佇列(CRTDTAQ)參數 TYPE 指定值為 *DDM，DDM 代表分散式資
料管理(Distributed Data Management)，它同時告訴 AS/400(iSeries) 系統
這個資料佇列將指向於參數 RMTLOCNAME(Remote Location Name)所指定的另一個
AS/400(iSeries)系統上，在我們的例子中，參數 RMTLOCNAME 值為 RMTNAME，你需要
參考 CFGTCP Menu(Go CFGTCP)選項 10 中，遠端 AS/400 的主機名稱(Host name)。
參數 RMTLOCNAME 告訴系統遠端資料佇列所擺放的遠端系統，遠端資料佇列(Remote
Data Queue) 參數 RMTDTAQ 告訴本端系統，此遠端資料佇列放置於遠端系統的哪個
程式館及其名稱。所以要讓遠端資料佇列能有效運作，需要作如下的動作：
系統 A 系統 B
首先建立一個系統 B 本地端的資料佇列
CRTDTAQ DTAQ(QGPL/PASSUSERRM)
MAXLEN(1000)
SEQ(*KEYED)
KEYLEN(4)
接著於系統 A 建立遠端資料佇列 /\
(Remote Data Queue) ||
CRTDTAQ ||
DTAQ(QGPL/PASSUSER) ||
TYPE(*DDM) ||
MAXLEN(1000) ||
SEQ(*KEYED) ||
KEYLEN(4) ||
RMTDTAQ(QGPL/PASSUSERRM) <===================|| 指向系統 B 的資料佇列
RMTLOCNAME(RMTNAME)
要注意的是系統 A 建立遠端資料佇列參數 RMTDTAQ 要指定系統 B 本地端的資料佇
列名稱。
上述說明是主要系統所要做的動作，我們設定程序檢核點 QIBM_QSY_CRT_PROFILE
(exit point)連結到一支程序檢核程式(跳出程式 exit program)需當新增使用者
設定檔時，自動呼叫程序檢核程式傳送新增使用者設定檔資訊至第二台 AS/400
系統，所有其他的動作就是第二台 AS/400 系統取得使用者設定檔資訊，並新增
一個同樣的使用者設定檔於第二台 AS/400 系統中。表二列出完成這些動作的部
分原始碼。
在遠端系統上的這支程式利用 QRCVDTAQ API 從資料佇列(data queue)讀取資訊，
然後將資訊組成指令 CRTUSRPRF(新增使用者設定檔)所需要的參數，並利用 "system"
程序執行指令 CRTUSRPRF(新增使用者設定檔)。
相信上述的說明能幫助您自動化的管理使用者設定檔。
表一主要系統程序檢核點 QIBM_QSY_CRT_PROFILE(exit point)的程序檢核程式
CRTPRFEXTR (跳出程式 exit program)：
**********************************************************************
* Program name : CRTPRFEXTR *
* Date : 2002/09/16 *
**********************************************************************
* Before you use the program to syncronize User profile between
* AS/400(iSeries) systems, you need
*
* CRTBNDRPG CRTPRFEXTR
*
* Create a data queue on target system by following command :
* CRTDTAQ DTAQ(QGPL/PASSUSERRM) MAXLEN(1000) SEQ(*KEYED) KEYLEN(4)
*
* Create a remote data queue on source system by following command :
* 使用 TCP/IP 方式:
* CRTDTAQ +
* DTAQ(QGPL/PASSUSER) +
* TYPE(*DDM) +
* MAXLEN(1000) +
* SEQ(*KEYED) +
* KEYLEN(4) +
* RMTDTAQ(QGPL/PASSUSERRM) +
* RMTLOCNAME(RMTNAME)
*
* 或使用 APPC 方式:
*
* CRTDTAQ +
* DTAQ(QGPL/PASSUSER) +
* TYPE(*DDM) +
* MAXLEN(1000) +
* SEQ(*KEYED) +
* KEYLEN(4) +
* RMTDTAQ(QGPL/PASSUSERRM) +
* RMTLOCNAME(RMTNAME)
* PS: RMTNAME specified in APPC device under communication line
*
* Add Exit program to Create User Profile exit point on source system:
*
* ADDEXITPGM +
* EXITPNT(QIBM_QSY_CRT_PROFILE) +
* FORMAT(CRTP0100) +
* PGMNBR(*LOW) +
* PGM(xxx/CRTUSREXTR)
*
H DEBUG OPTION(*SRCSTMT:*NODEBUGIO) DFTACTGRP(*NO)
*/COPY QSYSINC/QRPGLESRC,QSYRUSRI
DQSYI0300 DS Based(ReceivePtr)
D* Qsy USRI0300
D QSYBRTN02 1 4B 0
D* Bytes Returned
D QSYBAVL02 5 8B 0
D* Bytes Available
D QSYUP03 9 18
D* User Profile
D QSYPS00 19 31
D* Previous Signon
D QSYRSV103 32 32
D* Reserved 1
D QSYSN00 33 36B 0
D* Signon Notval
D QSYUS02 37 46
D* User Status
D QSYPD02 47 54
D* Pwdchg Date
D QSYNP00 55 55
D* No Password
D QSYRSV203 56 56
D* Reserved 2
D QSYPI01 57 60B 0
D* Pwdexp Interval
D QSYPD03 61 68
D* Pwdexp Date
D QSYPD04 69 72B 0
D* Pwdexp Days
D QSYPE00 73 73
D* Password Expired
D QSYUC00 74 83
D* User Class
D QSYAOBJ01 84 84
D* All Object
D QSYSA05 85 85
D* Security Admin
D QSYJC01 86 86
D* Job Control
D QSYSC01 87 87
D* Spool Control
D QSYSS02 88 88
D* Save System
D QSYRVICE01 89 89
D* Service
D QSYAUDIT01 90 90
D* Audit
D QSYISC01 91 91
D* Io Sys Cfg
D QSYERVED10 92 98
D* Reserved
D QSYGP02 99 108
D* Group Profile
D QSYOWNER01 109 118
D* Owner
D QSYGA00 119 128
D* Group Auth
D QSYAL04 129 138
D* Assistance Level
D QSYCLIB 139 148
D* Current Library
D QSYNAME14 149 158
D* Name
D QSYBRARY14 159 168
D* Library
D QSYNAME15 169 178
D* Name
D QSYBRARY15 179 188
D* Library
D QSYLC00 189 198
D* Limit Capabilities
D QSYTD 199 248
D* Text Description
D QSYDS00 249 258
D* Display Signon
D QSYLDS 259 268
D* Limit DeviceSsn
D QSYKB 269 278
D* Keyboard Buffering
D QSYRSV300 279 280
D* Reserved 3
D QSYMS 281 284B 0
D* Max Storage
D QSYSU 285 288B 0
D* Storage Used
D QSYSP 289 289
D* Scheduling Priority
D QSYNAME16 290 299
D* Name
D QSYBRARY16 300 309
D* Library
D QSYAC 310 324
D* Accounting Code
D QSYNAME17 325 334
D* Name
D QSYBRARY17 335 344
D* Library
D QSYMD 345 354
D* Msgq Delivery
D QSYRSV4 355 356
D* Reserved 4
D QSYMS00 357 360B 0
D* Msgq Severity
D QSYNAME18 361 370
D* Name
D QSYBRARY18 371 380
D* Library
D QSYPD05 381 390
D* Print Device
D QSYSE 391 400
D* Special Environment
D QSYNAME19 401 410
D* Name
D QSYBRARY19 411 420
D* Library
D QSYLI 421 430
D* Language Id
D QSYCI 431 440
D* Country Id
D QSYCCSID00 441 444B 0
D* CCSID
D QSYSK00 445 445
D* Show Keywords
D QSYSD00 446 446
D* Show Details
D QSYFH00 447 447
D* Fullscreen Help
D QSYSS03 448 448
D* Show Status
D QSYNS00 449 449
D* Noshow Status
D QSYRK00 450 450
D* Roll Key
D QSYPM00 451 451
D* Print Message
D QSYERVED11 452 480
D* Reserved
D QSYNAME20 481 490
D* Name
D QSYBRARY20 491 500
D* Library
D QSYOBJA18 501 510
D* Object Audit
D QSYCMDS00 511 511
D* Command Strings
D QSYREATE00 512 512
D* Create
D QSYELETE00 513 513
D* Delete
D QSYJD01 514 514
D* Job Data
D QSYOBJM07 515 515
D* Object Mgt
D QSYOS00 516 516
D* Office Services
D QSYPGMA00 517 517
D* Program Adopt
D QSYSR00 518 518
D* Save Restore
D QSYURITY00 519 519
D* Security
D QSYST00 520 520
D* Service Tools
D QSYSFILD00 521 521
D* Spool File Data
D QSYSM00 522 522
D* System Management
D QSYTICAL00 523 523
D* Optical
D QSYERVED12 524 574
D* Reserved
D QSYGAT00 575 584
D* Group Auth Type
D QSYSGO00 585 588B 0
D* Supp Group Offset
D QSYSGNBR02 589 592B 0
D* Supp Group Number
D QSYUID 593 596U 0
D* UID
D QSYGID 597 600U 0
D* GID
D QSYHDO 601 604B 0
D* HomeDir Offset
D QSYHDL 605 608B 0
D* HomeDir Len
D QSYLJA 609 624
D* Locale Job Attributes
D QSYLO 625 628B 0
D* Locale Offset
D QSYLL 629 632B 0
D* Locale Len
D QSYGMI03 633 633
D* Group Members Indicator
D QSYDCI 634 634
D* Digital Certificate Indicato
D QSYCC 635 644
D* Chrid Control
D QSYSPSDO 645 648B 0
D* IASP Storage Dsc Offset
D QSYSPSDC 649 652B 0
D* IASP Storage Dsc Count
D QSYPSDCR 653 656B 0
D* IASP Storage Dsc Count Rtn
D QSYSPSDL 657 660B 0
D* IASP Storage Dsc Length
D*QSYSGN02 661 670 DIM(00001)
D*
D* Varying length
D*QSYPI02 671 671
D*
D* Varying length
D*QSYLI00 672 672
D*
D* Varying length
D*QSYASPSD00 20 DIM(00001)
D* QSYIASPN00 10 OVERLAY(QSYASPSD00:00001)
D* QSYERVED36 2 OVERLAY(QSYASPSD00:00011)
D* QSYMS02 9B 0 OVERLAY(QSYASPSD00:00013)
D* QSYSU01 9B 0 OVERLAY(QSYASPSD00:00017)
D*
D* Varying length
/COPY QSYSINC/QRPGLESRC,QUSEC
d RtvEncPwd PR 38
d PmProfile 10 const
d Data S 1000
d DataQue S 10 inz('PASSUSERRM')
d DataQueLib S 10 inz('QGPL ')
d DataLength S 5 0 inz(1000)
D FormatName S 8 inz('USRI0300')
D InData S 38
d UsrProFile S 10
d Key S 4 inz('0000')
d KeyLength S 3 0 inz(4)
D OI S 4 0
D ReceiveLen S 10i 0
D Receiver1 DS
D BytesRtn1 10i 0
D BytesAvl1 10i 0
D PassWordDs Ds 38
C *Entry PList
C Parm InData
C Eval UsrProFile = %Subst(InData : 29 : 10)
* Retrieve the user profile information
C Call 'QSYRUSRI'
C Parm Receiver1
C Parm 8 ReceiveLen
C Parm FormatName
C Parm UsrProfile
C Parm QusEc
c Alloc BytesAvl1 ReceivePtr
C Call 'QSYRUSRI'
C Parm QSYI0300
C Parm BytesAvl1 ReceiveLen
C Parm FormatName
C Parm UsrProfile
C Parm QusEc
* Retrieve the encrypted password data
c Eval PassWordDs = RtvEncPwd(UsrProfile)
c Eval DataLength = BytesAvl1 + 38
c Eval Data = PassWordDs + Qsyi0300
* Write the information to the DDM data queue
c CALL 'QSNDDTAQ'
C PARM DataQue
C PARM DataQueLib
C PARM DataLength
C PARM Data
C PARM KeyLength
C PARM Key
c Eval *inlr = *on
* procedure RtvEncPwd: Retrieve encrypted password for given user
P RtvEncPwd B export
d RtvEncPwd PI 38
d PmProfile 10 const
DQSYD0100 DS Based(ReceivePtr)
D* Qsy RUPWD UPWD0100
D QSYBRTN04 1 4B 0
D* Bytes Returned
D QSYBAVL04 5 8B 0
D* Bytes Available
D QSYPN06 9 18
D* Profile Name
D PassWord 19 38
D Receiver1 DS
D BytesRtn1 10i 0
D BytesAvl1 10i 0
DQUSEC DS 116 inz
D QUSBPRV 1 4B 0 inz(116)
D QUSBAVL 5 8B 0 inz(0)
D QUSEI 9 15
D QUSERVED 16 16
D QUSED01 17 116
D FormatName S 8 Inz('UPWD0100')
D InProfile S 10
D ReceiveLen S 10i 0
c Eval InProfile = PmProfile
C Call 'QSYRUPWD'
C Parm Receiver1
C Parm 8 ReceiveLen
C Parm FormatName
C Parm InProfile
C Parm QusEc
c Alloc BytesAvl1 ReceivePtr
C Call 'QSYRUPWD'
C Parm QsyD0100
C Parm BytesAvl1 ReceiveLen
C Parm FormatName
C Parm InProfile
C Parm QusEc
c Return QsyD0100
P RtvEncPwd E
表二：在遠端系統上的 RTVUSRINFR 程式列表
**********************************************************************
* Program name : RTVUSRINFR *
* Date : 2002/09/16 *
**********************************************************************
*
* CRTBNDRPG RTVUSRINFR
*
* CRTDTAQ DTAQ(QGPL/PASSUSERRM) MAXLEN(1000) SEQ(*KEYED) KEYLEN(4)
*
* SBMJOB CMD(CALL PGM(RTVUSRINFR)) JOB(AUTOCRTPRF)
*
H DEBUG OPTION(*SRCSTMT:*NODEBUGIO) BNDDIR('QC2LE') DFTACTGRP(*NO)
d System PR 10i 0 extproc('system')
d Cmd * value options(*string)
d CpfMsgId S 7 import('_EXCP_MSGID')
d FormatCmd PR 1000
d UsrProfile 10 const
d SetEncPwd PR
d PwdStruct 38
DPassWordDs DS 38
DReceiveDs DS 1000
d ProfData 39 1000
d pwdexpitvb 95 98B 0
d maxstgb 319 322B 0
d msgsevb 395 398B 0
d ccsidb 479 482B 0
DQSYI0300 DS
D QSYUP03 9 18
D* User Profile
D QSYURITY00 519 519
D* Security
d DataQue S 10 inz('PASSUSERRM')
d DataQueLib S 10 inz('QGPL ')
d DataLength S 5 0 inz(1000)
d Key S 4 inz('0000')
d KeyLength S 3 0 inz(4)
d KeyOrder S 2 inz('EQ')
d SenderInf S 50
d SenderLen S 3 0 inz(50)
d WaitLength S 5 0 inz(-1)
* Read the data queue as entries arrive
c CALL 'QRCVDTAQ'
C PARM DataQue
C PARM DataQueLib
C PARM DataLength
C PARM ReceiveDs
C PARM WaitLength
C PARM KeyOrder
C PARM KeyLength
C PARM Key
C PARM SenderLen
C PARM SenderInf
c Movel ReceiveDs PassWordDs
c Movel ProfData Qsyi0300
* execute the command to create the user profile
c If System(FormatCmd(QsyUp03)) > 0
* If procedure returned not zero, display the error msgid
c CpfMsgId dsply
C* Dump
c Else
* Set the password the same as in the original profile
c Callp SetEncPwd(PassWordDs)
c
c Endif
c
c eval *inlr = *on
P FormatCmd B export
d FormatCmd PI 1000
d UsrProfile 10 const
D cmdStr S 1000 inz
D password S 10 inz('*USRPRF')
D pwdexp S 4
D status S 9
D usrcls S 10
D astlvl S 9
D curlib S 10
D inlpgm S 10
D inlpgml S 10
D fullinlpgm S 21
D inlmnu S 10
D inlmnul S 10
D lmtcpb S 8
D text S 50
D spcaut S 80
D spcautind S 1
D spcenv S 9
D dspsgninf S 9
D pwdexpitv S 9
D lmtdevssn S 9
D kbdbuf S 9
D maxstg S 9
D ptylmt S 1
D fulljobd S 21
D jobdname S 10
D jobdlib S 10
D grpprf S 10
D owner S 7
D grpaut S 8
D grpauttyp S 8
D acgcde S 15
D msgq S 21
D dlvry S 7
D msgsev S 6
D prtdev S 10
D outq S 21
D atn S 21
D srt S 21
D langid S 7
D cntryid S 7
D ccsid S 11
D chridctl S 9
D tempn S 10
* PWDEXP
C If %SubSt(ProfData : 73 : 1) = 'Y'
C Eval pwdexp = '*YES'
C Else
C Eval pwdexp = '*NO '
C EndIf
C Eval status = %SubSt(ProfData : 37 : 10)
C Eval usrcls = %SubSt(ProfData : 74 : 10)
C Eval astlvl = %SubSt(ProfData : 129 : 10)
C Eval curlib = %SubSt(ProfData : 139 : 10)
C Eval inlpgm = %SubSt(ProfData : 169 : 10)
C Eval inlpgml= %SubSt(ProfData : 179 : 10)
C If inlpgm = '*NONE '
C Eval fullinlpgm = '*NONE'
C Else
C Eval fullinlpgm = %trim(inlpgml) + '/' +
C %trim(inlpgm)
C EndIf
C Eval inlmnu = %SubSt(ProfData : 149 : 10)
C Eval inlmnul= %SubSt(ProfData : 159 : 10)
C Eval lmtcpb = %SubSt(ProfData : 189 : 10)
C Eval text = %SubSt(ProfData : 199 : 10)
*SPCAUT
C Eval spcautind = '0'
C If %SubSt(ProfData : 84 : 1) = 'Y'
C Eval spcaut = '*ALLOBJ'
C Eval spcautind = '1'
C EndIf
C If %SubSt(ProfData : 85 : 1) = 'Y'
C Eval spcaut = %trim(spcaut) + ' *SECADM'
C Eval spcautind = '1'
C EndIf
C If %SubSt(ProfData : 86 : 1) = 'Y'
C Eval spcaut = %trim(spcaut) + ' *JOBCTL'
C Eval spcautind = '1'
C EndIf
C If %SubSt(ProfData : 87 : 1) = 'Y'
C Eval spcaut = %trim(spcaut) + ' *SPLCTL'
C Eval spcautind = '1'
C EndIf
C If %SubSt(ProfData : 88 : 1) = 'Y'
C Eval spcaut = %trim(spcaut) + ' *SAVSYS'
C Eval spcautind = '1'
C EndIf
C If %SubSt(ProfData : 89 : 1) = 'Y'
C Eval spcaut = %trim(spcaut) + ' *SERVICE'
C Eval spcautind = '1'
C EndIf
C If %SubSt(ProfData : 90 : 1) = 'Y'
C Eval spcaut = %trim(spcaut) + ' *AUDIT'
C Eval spcautind = '1'
C EndIf
C If %SubSt(ProfData : 91 : 1) = 'Y'
C Eval spcaut = %trim(spcaut) + ' *IOSYSCFG'
C Eval spcautind = '1'
C EndIf
C If spcautind = '0'
C Eval spcaut = '*NONE'
C EndIf
C Eval spcenv = %SubSt(ProfData : 391 : 10)
C Eval dspsgninf = %SubSt(ProfData : 249 : 10)
*PWDEXPITV
C If pwdexpitvb = 0
C Eval pwdexpitv ='*SYSVAL'
C Else
C If pwdexpitvb = -1
C Eval pwdexpitv ='*NOMAX'
C Else
C MoveL pwdexpitvb pwdexpitv
C EndIf
C EndIf
C Eval lmtdevssn = %SubSt(ProfData : 259 : 10)
C Eval kbdbuf = %SubSt(ProfData : 269 : 10)
C
*MAXSTG
C If maxstgb = -1
C Eval maxstg = '*NOMAX'
C Else
C MoveL maxstgb maxstg
C EndIf
*PTYLMT
C Eval ptylmt = %SubSt(ProfData : 289 : 1)
*JOBD
C Eval jobdlib = %SubSt(ProfData : 300 : 10)
C Eval jobdname = %SubSt(ProfData : 290 : 10)
C Eval fulljobd = %trim(jobdlib) + '/' +
C %trim(jobdname)
*GRPPRF
C Eval grpprf = %SubSt(ProfData : 99 : 10)
*OWNER
C Eval owner = %SubSt(ProfData : 109 : 10)
*GRPAUT
C Eval grpaut = %SubSt(ProfData : 119 : 10)
*GRPAUTTYP
C Eval grpauttyp = %SubSt(ProfData : 575 : 10)
*ACGCDE
C Eval acgcde = %SubSt(ProfData : 310 : 15)
*MSGQ
C Eval msgq = %trim(%SubSt(ProfData : 335 : 10)) +
C '/' +
C %trim(%SubSt(ProfData : 325 : 10))
*DLVRY
C Eval dlvry = (%SubSt(ProfData : 345 : 10))
*MSG SEV
C Movel msgsevb msgsev
*PRTDEV
C Eval prtdev = (%SubSt(ProfData : 381 : 10))
*OUTQ
C Eval tempn= %trim(%SubSt(ProfData : 361 : 10))
C If tempn = '*WRKSTN ' or
C tempn = '*DEV '
C Eval outq = tempn
C Else
C Eval outq = %trim(%SubSt(ProfData : 371 : 10)) +
C '/' +
C %trim(%SubSt(ProfData : 361 : 10))
C EndIf
*ATNPGM
C Eval tempn= %trim(%SubSt(ProfData : 401 : 10))
C If tempn<> '*SYSVAL ' or
C tempn<> '*NONE ' or
C tempn<> '*ASSIST '
C Eval atn = tempn
C Else
C Eval atn = %trim(%SubSt(ProfData : 411 : 10)) +
C '/' +
C %trim(%SubSt(ProfData : 401 : 10))
C EndIf
*SRTSEQ
C Eval tempn = %SubSt(ProfData : 481 : 10)
C If (tempn = '*HEX ') OR
C (tempn = '*LANGIDUNQ') OR
C (tempn = '*LANGIDSHR') OR
C (tempn = '*SYSVAL ')
C Eval srt = tempn
C Else
C Eval srt = %trim(%SubSt(ProfData : 491 : 10)) +
C '/' +
C %trim(%SubSt(ProfData : 481 : 10))
C EndIf
*LANGID
C Eval langid= %SubSt(ProfData : 421 : 10)
*CNTRYID
C Eval cntryid= %SubSt(ProfData : 431 : 10)
*CCSID
C If ccsidb = -2
C Eval ccsid = '*SYSVAL'
C Else
C Movel ccsidb ccsid
C EndIf
*CHRIDCTL
C Eval cntryid= %SubSt(ProfData : 635 : 10)
C Eval cmdStr = 'CRTUSRPRF ' +
C 'USRPRF(' + %trim(UsrProfile) + ') ' +
C 'PASSWORD(*USRPRF) ' +
C 'PWDEXP(' + %trim(pwdexp) + ') ' +
C 'STATUS(' + %trim(status) + ') ' +
C 'USRCLS(' + %trim(usrcls) + ') ' +
C 'ASTLVL(' + %trim(astlvl) + ') ' +
C 'CURLIB(' + %trim(curlib) + ') ' +
C 'INLPGM(' + %trim(fullinlpgm) + ') ' +
C 'INLMNU(' + %trim(inlmnul) +
C '/' + %trim(inlmnu) +
C ') ' +
C 'LMTCPB(' + %trim(lmtcpb) + ') ' +
C 'TEXT(' + %trim(text) + ') ' +
C 'SPCAUT(' + %trim(spcaut)+ ') ' +
C 'SPCENV(' + %trim(spcenv) + ') ' +
C 'DSPSGNINF('+ %trim(dspsgninf) + ') ' +
C 'PWDEXPITV('+ %trim(pwdexpitv) + ') ' +
C 'KBDBUF(' + %trim(kbdbuf) + ') ' +
C 'MAXSTG(' + %trim(maxstg) + ') ' +
C 'PTYLMT(' + %trim(ptylmt) + ') ' +
C 'JOBD(' + %trim(fulljobd) + ') ' +
C 'GRPPRF(' + %trim(grpprf) + ') ' +
C 'OWNER(' + %trim(owner) + ') ' +
C 'GRPAUT(' + %trim(grpaut) + ') ' +
C 'GRPAUTTYP('+ %trim(grpauttyp) + ') ' +
C 'ACGCDE(' + %trim(acgcde) + ') ' +
C 'MSGQ(' + %trim(msgq) + ') ' +
C 'DLVRY(' + %trim(dlvry) + ') ' +
C 'SEV(' + %trim(msgsev) + ') ' +
C 'PRTDEV(' + %trim(prtdev) + ') ' +
C 'OUTQ(' + %trim(outq) + ') ' +
C 'ATNPGM(' + %trim(atn) + ') ' +
C 'SRTSEQ(' + %trim(srt) + ') ' +
C 'LANGID(' + %trim(langid) + ') ' +
C 'CNTRYID(' + %trim(cntryid) + ') ' +
C 'CCSID(' + %trim(ccsid) + ') ' +
C 'CHRIDCTL(' + %trim(chridctl) + ') '
C Dump
C Return CmdStr
P FormatCmd E
P SetEncPwd B export
d SetEncPwd PI
d QSYSD0100 38
DQUSEC DS 116 inz
D QUSBPRV 1 4B 0 inz(116)
D QUSBAVL 5 8B 0 inz(0)
D QUSEI 9 15
D QUSERVED 16 16
D QUSED01 17 116
D FormatName S 8 Inz('UPWD0100')
C Call 'QSYSUPWD'
C Parm QsysD0100
C Parm FormatName
C Parm QusEc
c Return
P SetEncPwd E
星期一, 11月 06, 2023
2003-04-11 如何讓多部 AS/400(iSeries) 系統間的使用者設定檔(User Profile)同步 ?
訂閱：
張貼留言 (Atom)
沒有留言:
張貼留言