このドキュメントでは、ACB インターフェイスを使用する次のようなダイレクトコールの例について説明します。
このセクションでは、アセンブラでの Adabas ダイレクトコールの使用例を示します。 いずれの例でも、以前に定義した Adabas ファイルを使用しています。
*** CONTROL BLOCK
DS 0F
CB DS 0CL80 USER CONTROL BLOCK
DC CL2' ' RESERVED FOR ADABAS USE
CCODE DC CL2' ' COMMAND CODE
CID DC CL4' ' COMMAND ID
FNR DC H'0' FILE NUMBER
RC DC H'0' RESPONSE CODE
ISN DC F'0' ISN
ISNLL DC F'0' ISN LOWER LIMIT
ISNQ DC F'0' ISN QUANTITY
FBL DC H'100' FORMAT BUFFER LENGTH
RBL DC H'250' RECORD BUFFER LENGTH
SBL DC H'50' SEARCH BUFFER LENGTH
VBL DC H'100' VALUE BUFFER LENGTH
IBL DC H'20' ISN BUFFER LENGTH
COPT1 DC CL1' ' COMMAND OPTION 1
COPT2 DC CL1' ' COMMAND OPTION 2
ADD1 DC CL8' ' ADDITIONS 1
ADD2 DC CL4' ' ADDITIONS 2
ADD3 DC CL8' ' ADDITIONS 3
ADD4 DC CL8' ' ADDITIONS 4
ADD5 DC CL8' ' ADDITIONS 5
CTIME DC F'0' COMMAND TIME
UAREA DC CL4' ' USER AREA
*
*
*** USER BUFFER AREAS
FB DC CL100' ' FORMAT BUFFER
RB DC CL250' ' RECORD BUFFER
SB DC CL50' ' SEARCH BUFFER
VB DC CL100' ' VALUE BUFFER
IB DC CL20' ' ISN BUFFER
* * *
このセクションでは、次の例を記載しています。
XB=99 であるファイル 2 のレコードを検索します。
GET NEXT オプションを使って選択した各レコードを読みます。
EXMP1 MVC CCODE,=C'OP' OP COMMAND
MVC RB(4),=C'ACC.' ACCESS ONLY REQUESTED
CALL ADABAS,(CB,FB,RB) CALL ADABAS
CLC RC,=H'0' CHECK RESPONSE CODE
BNE EX1ERR BRANCH IF NOT 0
MVC CCODE,=C'S1' FIND COMMAND
MVC CID,=C'S101' NONBLANK CID REQUIRED FOR
* IDENTIFICATION OF THE LIST
MVC FNR,=H'2' FILE 2
MVC ISNLL,=F'0' ALL QUALIFYING ISNS DESIRED
MVC IBL,=H'0' ISN BUFFER NOT REQUIRED
MVI FB,C'.' NO READ OF DATA STORAGE
MVC SB(7),=C'XB,3,U.' SEARCH CRITERION
MVC VB(3),=C'099' SEARCH VALUE
CALL ADABAS,(CB,FB,RB,SB,VB) CALL ADABAS
CLC RC,=H'0' CHECK RESPONSE CODE
BNE EX1ERR BRANCH IF NOT 0
CLC ISNQ,=F'0' CHECK NUMBER OF ISNS FOUND
BE EX1EXIT BRANCH TO EXIT IF NO ISNS FOUND
EX1B MVC CCODE,=C'L1' READ COMMAND
MVC ISN,=F'0' BEGIN WITH 1ST ISN IN LIST
MVI COPT2,C'N' GET NEXT OPTION TO BE USED
MVC FB(3),=C'RG.' ALL FIELDS TO BE RETURNED
EX1C CALL ADABAS,(CB,FB,RB) CALL ADABAS
CLC RC,=H'0' CHECK RESPONSE CODE
BE EX1D BRANCH IF RESPONSE CODE 0
CLC RC,=H'3' CHECK IF ALL RECORDS READ
BE EX1EXIT BRANCH IF YES
B EX1ERR BRANCH TO ERROR ROUTINE
EX1D . . . PROCESS RECORD . . .
B EX1C BRANCH TO READ NEXT RECORD
EX1ERR EQU * * DISPLAY ERROR MESSAGE * . TERMINATE USER PROGRAM
EX1EXIT MVC CCODE,=C'CL' CLOSE COMMAND
CALL ADABAS,(CB) CALL ADABAS
CLC RC,=H'0' CHECK RESPONSE CODE
BNE EX1ERR BRANCH IF NOT 0
ファイル 1 のレコードは、物理順に全部読み込まれます。
読み込んだ各レコードを次の値で更新します。
フィールド AA = ABCDEFGH
フィールド AB = 500
ユーザーは、ファイル 1 の排他制御権限を持つことが前提です。
EXMP2 MVC CCODE,=C'OP' OPEN COMMAND
MVC RB(6),=C'EXU=1.' EXCLUSIVE CONTROL REQUESTED
CALL ADABAS,(CB,FB,RB) CALL ADABAS
CLC RC,=H'0' CHECK RESPONSE CODE
BE EX2A BRANCH IF RESPONSE CODE 0
B EX2ERR BRANCH IF NOT 0
EX2A MVC CID,=C'L201' NONBLANK CID REQUIRED
MVC FNR,=H'1' FILE 1 TO BE READ
MVC ISN,=F'0' ALL RECORDS TO BE READ
MVC FB(3),=C'GA.' VALUES FOR FIELDS AA AND AB
* (GROUP GA) TO BE RETURNED
EX2B MVC CCODE,=C'L2' READ PHYS. SEQ.
CALL ADABAS,(CB,FB,RB) CALL ADABAS
CLC RC,=H'0' CHECK RESPONSE CODE
BE EX2C BRANCH IF RESPONSE CODE 0
CLC RC,=H'3' CHECK FOR END-OF-FILE
BE EX2EXIT BRANCH TO EXIT IF END-OF-FILE
B EX2ERR BRANCH TO ERROR ROUTINE
読み込まれたフィールドと同じフィールドが更新されます。
同じ CID とフォーマットバッファを更新コマンドに使用できます。
更新対象のレコードの ISN は、L2 コマンドの結果として、ISN フィールドにすでに存在していることが前提です。
EX2C MVC CCODE,=C'A1' UPDATE COMMAND
MVC RB(8),=C'ABCDEFGH' VALUE FOR FIELD AA
MVC RB+8(2),=PL2'500' VALUE FOR FIELD AB
CALL ADABAS,(CB,FB,RB) CALL ADABAS
CLC RC,=H'0' CHECK RESPONSE CODE
BE EX2B BRANCH TO READ NEXT RECORD
EX2ERR EQU * * . DISPLAY ERROR MESSAGE * . TERMINATE USER PROGRAM
EX2EXIT MVC CCODE,=C'CL' CLOSE COMMAND
CALL ADABAS,(CB) CALL ADABAS
CLC RC,=H'0' CHECK RESPONSE CODE
BNE EX2ERR BRANCH IF NOT 0
. . .
ユーザーセッションの初期化時に、ユーザープログラムは、前回のユーザーションで、最後に正常に完了したトランザクションを示す情報を表示します。
ユーザートランザクションごとのユーザープログラムの処理内容は次のとおりです。
ファイル 1 と 2 の更新用のキーとして使われる 8 文字の入力を端末から受け入れます。
ファイル 1 に対して FIND コマンドを発行し、フィールド AA = 入力キーのレコードが存在するかどうか判断します。
レコードが 1 件も見つからなかった場合、ユーザープログラムはメッセージを発行します。 レコードが見つかった場合のユーザープログラムの処理内容は次のとおりです。
ファイル 1 からそのレコードを削除します
ファイル 2 に新しいレコード（フィールド RA= 入力された入力キー）を追加します。
その他のフィールドは空値にします。
レコードを正常に追加できない場合、ユーザープログラムは、BT コマンドを発行して、エラーメッセージを表示します。
両方とも正常に更新された場合、ユーザープログラムは ET コマンドを発行します。
図のプログラムのセクションは、ユーザーセッションの初期化時にのみ実行されます。
OP コマンドが発行されるときに、前回のセッションの ET データが読み込まれます。
EXMP3 EQU *
MVC CCODE,=C'OP' OPEN COMMAND
MVI COPT2,C'E' ET DATA TO BE READ
MVC ADD1,=C'USER0001' USER IDENTIFICATION
MVC ADD3,=C'PASSWORD' USER PASSWORD
MVC RB(8),=C'UPD=1,2.' FILES 1 AND 2 TO BE UPDATED
CALL ADABAS,(CB,FB,RB) CALL ADABAS
CLC RC,=H'0' CHECK RESPONSE CODE
BE EX3A BRANCH IF RESPONSE CODE 0
CLC RC,=H'9' CHECK FOR RESPONSE CODE 9
BE EXMP3 BRANCH TO REPEAT OPEN
B EX3ERR BRANCH IF NOT 0 OR 9
EX3A EQU *
CLC CID,=F'0' CHECK IF ET DATA FROM
* PREVIOUS SESSION EXISTS
BE EX3B BRANCH IF NO ET DATA
* . . .
レコードバッファ内にある ET データを端末画面に表示して、前回のユーザーセッションで最後に正常に完了したトランザクションをユーザーに知らせます。
B EX3C BRANCH TO BEGIN TRANS. PROCESS. EX3B EQU *
ET データを受け取らなかった場合は、前回のユーザーセッションで正常に完了したトランザクションがなかったことを示すメッセージが表示されます。
このセクションは、ユーザートランザクションごとに実行されます。
EX3C EQU * * . . . ACCEPT INPUT FROM TERMINAL . . .
ファイル 1 に対して FIND コマンドを発行し、入力された入力キーと等しいレコードがフィールド AA に存在するかどうか判断します。
EX3D EQU *
MVC CCODE,=C'S4' FIND WITH HOLD COMMAND
MVC CID,=C' ' ISN LIST NOT TO BE SAVED
MVC FNR,=H'1' FILE 1
MVC ISNLL,=F'0' ALL QUALIFY. ISNS TO BE RETURNED
MVI FB,C'.' NO READ OF DATA STORAGE
MVC SB(3),=C'AA.' SEARCH CRITERION
MVC VB(8),INPUT SEARCH VALUE
CALL ADABAS,(CB,FB,RB,SB,VB,IB) CALL ADABAS
CLC RC,=H'0' CHECK RESPONSE CODE
BE EX3E BRANCH IF RESPONSE CODE 0
B EX3ERR BRANCH TO ERROR ROUTINE
EX3E EQU *
CLC ISNQ,=F'0' CHECK NUMBER OF RECORDS FOUND
BNE EX3F BRANCH IF RECORD FOUND
レコードが 1 件も見つからなかった場合、ユーザープログラムによって修正を要求するメッセージが発行されます。
B EX3C RETURN TO ACCEPT USER INPUT
削除対象のレコードの ISN は、S4 コマンドの結果として、ISN フィールドにホールド状態ですでに存在しています。
EX3F EQU *
MVC CCODE,=C'E4' DELETE COMMAND
CALL ADABAS,(CB) CALL ADABAS
CLC RC,=H'0' CHECK RESPONSE CODE
BE EX3G BRANCH IF RESPONSE CODE 0
CLC RC,=H'9' CHECK IF CURRENT TRANS. HAS BEEN
* BACKED OUT BY ADABAS
BE EX3D IF YES, BRANCH TO REPEAT S4
B EX3ERR BRANCH TO ERROR ROUTINE
EX3G EQU *
MVC CCODE,=C'N1' ADD NEW RECORD
MVC FNR,=H'2' FILE 2
MVC FB(6),=C'RA.' VALUE BEING PROVIDED FOR RA
MVC RB(8),INPUT VALUE FOR FIELD RA
CALL ADABAS,(CB,FB,RB) CALL ADABAS
CLC RC,=H'0' CHECK RESPONSE CODE
BE EX3I BRANCH IF RESPONSE CODE 0
CLC RC,=H'9' WAS TRANSACTION BACKED OUT?
BE EX3D IF YES, RETURN TO REISSUE TRANS.
新しいレコードの追加が成功しなかった場合、トランザクションはバックアウトされ、エラー状態が存在することがユーザーに通知されます。
MVC CCODE,=C'BT' BACKOUT TRANSACTION
CALL ADABAS,(CB) CALL ADABAS
CLC RC,=H'0' CHECK IF RESPONSE CODE 0
BE EX3H BRANCH IF 0
バックアウトが成功しなかった場合は、その結果を示すメッセージが発行されます。
B EX3ERR BRANCH TO ERROR ROUTINE EX3H EQU *
バックアウトに成功した場合は、エラーの検出後、トランザクションがバックアウトされたことを示すメッセージが発行されます。
B EX3ERR BRANCH TO ERROR ROUTINE
更新が正常に実行された場合は、ET データでの ET コマンドが発行されます。
EX3I EQU *
MVC CCODE,=C'ET' END OF TRANSACTION COMMAND
MVI COPT2,C'E' ET DATA TO BE WRITTEN
MVC RB(8),INPUT ET DATA CONSISTS OF INPUT KEY OF THIS TRANSACTION
CALL ADABAS,(CB,FB,RB) CALL ADABAS
CLC RC,=H'0' CHECK RESPONSE CODE
BE EX3C IF RESPONSE CODE 0, RETURN TO RECEIVE INPUT FOR
* THE NEXT TRANSACTION
CLC RC,=H'9' CHECK IF CURRENT TRANSACTION HAS BEEN BACKED OUT
* BY ADABAS
BE EX3D IF CURRENT TRANSACTION HAS BEEN BACKED OUT,
* RETURN TO REISSUE TRANSACTION
EX3ERR EQU *
* . NONZERO RESPONSE CODE RECEIVED
* . DISPLAY ERROR MESSAGE
* . TERMINATE USER PROGRAM
. . .
INPUT DS CL8 KEY ENTERED FROM TERMINAL
このセクションでは、COBOL での Adabas ダイレクトコールの使用例を示します。 各例では、以前に定義した Adabas ファイルを使用します。
*
*** CONTROL BLOCK
01 CONTROL-BLOCK.
02 FILLER PIC X(2) VALUE SPACES.
02 COMMAND-CODE PIC X(2) VALUE SPACES.
02 COMMAND-ID PIC X(4) VALUE SPACES.
02 FILE-NUMBER PIC S9(4) COMP VALUE +0.
02 RESPONSE-CODE PIC S9(4) COMP VALUE +0.
02 ISN PIC S9(8) COMP VALUE +0.
02 ISN-LOWER-LIMIT PIC S9(8) COMP VALUE +0.
02 ISN-QUANTITY PIC S9(8) COMP VALUE +0.
02 FORMAT-BUFFER-LENGTH PIC S9(4) COMP VALUE +100.
02 RECORD-BUFFER-LENGTH PIC S9(4) COMP VALUE +250.
02 SEARCH-BUFFER-LENGTH PIC S9(4) COMP VALUE +50.
02 VALUE-BUFFER-LENGTH PIC S9(4) COMP VALUE +100.
02 ISN-BUFFER-LENGTH PIC S9(4) COMP VALUE +20.
02 COMMAND-OPTION-1 PIC X VALUE SPACE.
02 COMMAND-OPTION-2 PIC X VALUE SPACE.
02 ADDITIONS-1 PIC X(8) VALUE SPACES.
02 ADDITIONS-2 PIC X(4) VALUE SPACES.
02 ADDITIONS-3 PIC X(8) VALUE SPACES.
02 ADDITIONS-4 PIC X(8) VALUE SPACES.
02 ADDITIONS-5 PIC X(8) VALUE SPACES.
02 COMMAND-TIME PIC S9(8) COMP VALUE +0.
02 USER-AREA PIC X(4) VALUE SPACES.
*
*** USER BUFFER AREAS
01 FORMAT-BUFFER PIC X(100) VALUE SPACES.
01 RECORD-BUFFER PIC X(250) VALUE SPACES.
01 SEARCH-BUFFER PIC X(50) VALUE SPACES.
01 VALUE-BUFFER PIC X(100) VALUE SPACES.
01 ISN-BUFFER PIC X(20) VALUE SPACES.
*
*** ADDITIONAL FIELDS USED IN THE EXAMPLES
01 PROGRAM-WORK-AREA.
05 COMM-ID PIC X(4).
05 COMM-ID-X REDEFINES COMM-ID PIC S9(8) COMP.
05 INPUT-KEY PIC X(8).
05 RECORD-BUFFER-EX2.
10 RECORD-BUFFER-A PIC X(8).
10 RECORD-BUFFER-B PIC S9(3) COMP-3.
05 RECORD-BUFFER-EX3.
10 OPEN-RECORD-BUFFER.
15 OPEN-RECORD-BUFFER-X PIC X(8).
15 FILLER PIC S9(8) COMP.
10 FILLER PIC X(18).
10 UPDATED-XC PIC X(6).
10 LAST-XD PIC X(8).
10 FILLER PIC X(5).
05 USER-DATA.
10 RESTART-XD PIC X(8).
10 RESTART-ISN PIC S9(8) COMP.
05 SYNC-CHECK-SWITCH PIC 9 VALUE 0.
05 AB-VALUE PIC S9(4) COMP-3 VALUE +500.
*
このセクションでは、次の例を記載しています。
XB=99 であるファイル 2 のレコードを検索します。
GET NEXT オプションを使って選択した各レコードを読みます。
EXMP1.
MOVE 'OP' TO COMMAND-CODE.
MOVE 'ACC.' TO RECORD-BUFFER.
CALL 'ADABAS'
USING CONTROL-BLOCK, FORMAT-BUFFER, RECORD-BUFFER.
IF RESPONSE-CODE NOT EQUAL TO 0 GO TO EX1ERR.
MOVE 'S1' TO COMMAND-CODE.
MOVE 'S101' TO COMMAND-ID.
MOVE 2 TO FILE-NUMBER.
MOVE 0 TO ISN-LOWER-LIMIT.
MOVE 0 TO ISN-BUFFER-LENGTH.
MOVE '.' TO FORMAT-BUFFER.
MOVE 'XB,3,U.' TO SEARCH-BUFFER.
MOVE '099' TO VALUE-BUFFER.
CALL 'ADABAS' USING CONTROL-BLOCK, FORMAT-BUFFER,
RECORD-BUFFER, SEARCH-BUFFER, VALUE-BUFFER.
IF RESPONSE-CODE NOT EQUAL TO 0 GO TO EX1ERR.
EX1A.
IF ISN-QUANTITY = 0 GO TO EX1EXIT.
EX1B.
MOVE 'L1' TO COMMAND-CODE.
MOVE 0 TO ISN.
MOVE 'N' TO COMMAND-OPTION-2.
MOVE 'RG.' TO FORMAT-BUFFER.
EX1C.
CALL 'ADABAS'
USING CONTROL-BLOCK, FORMAT-BUFFER, RECORD-BUFFER.
IF RESPONSE-CODE = 0 GO TO EX1D.
IF RESPONSE-CODE = 3 GO TO EX1EXIT.
EX1D.
. . . PROCESS RECORD . . .
GO TO EX1C.
EX1ERR. * .DISPLAY ERROR MESSAGE * .TERMINATE USER PROGRAM
EX1EXIT.
MOVE 'CL' TO COMMAND-CODE.
CALL 'ADABAS' USING CONTROL-BLOCK.
IF RESPONSE-CODE NOT EQUAL TO 0 GO TO EX1ERR.
ファイル 1 のレコードは、物理順に全部読み込まれます。
読み込んだ各レコードを次の値で更新します。
フィールド AA = ABCDEFGH
フィールド AB = 500
ユーザーは、ファイル 1 の排他制御権限を持つことが前提です。
EXMP2.
MOVE 'OP' TO COMMAND-CODE.
MOVE 'EXU=1.' TO RECORD-BUFFER.
CALL 'ADABAS' USING
CONTROL-BLOCK, FORMAT-BUFFER, RECORD-BUFFER.
IF RESPONSE-CODE NOT EQUAL TO 0 GO TO EX2ERR.
EX2A.
MOVE 'L201' TO COMMAND-ID.
MOVE 1 TO FILE-NUMBER.
MOVE 0 TO ISN.
MOVE 'GA.' TO FORMAT-BUFFER.
EX2B.
MOVE 'L2' TO COMMAND-CODE.
CALL 'ADABAS' USING
CONTROL-BLOCK, FORMAT-BUFFER, RECORD-BUFFER.
IF RESPONSE-CODE = 0 GO TO EX2C.
IF RESPONSE-CODE = 3 GO TO EX2EXIT.
GO TO EX2ERR.
読み込まれたフィールドと同じフィールドが更新されます。
同じ CID とフォーマットバッファを更新コマンドに使用できます。
更新対象のレコードの ISN は、L2 コマンドの結果として、ISN フィールドにすでに存在していることが前提です。
EX2C.
MOVE 'A1' TO COMMAND-CODE.
MOVE 'ABCDEFGH' TO RECORD-BUFFER-A.
MOVE AB-VALUE TO RECORD-BUFFER-B.
CALL 'ADABAS' USING
CONTROL-BLOCK, FORMAT-BUFFER, RECORD-BUFFER-EX2.
IF RESPONSE-CODE NOT EQUAL TO 0 GO TO EX2ERR.
GO TO EX2B.
EX2ERR.
. DISPLAY ERROR MESSAGE
. TERMINATE USER PROGRAM
EX2EXIT.
MOVE 'CL' TO COMMAND-CODE.
CALL 'ADABAS' USING CONTROL-BLOCK.
IF RESPONSE-CODE NOT EQUAL TO 0 GO TO EX2ERR.
ユーザーセッションの初期化時に、ユーザープログラムは、前回のユーザーションで、最後に正常に完了したトランザクションを示す情報を表示します。
ユーザートランザクションごとのユーザープログラムの処理内容は次のとおりです。
ファイル 1 と 2 の更新用のキーとして使われる 8 文字の入力を端末から受け入れます。
ファイル 1 に対して FIND コマンドを発行し、フィールド AA = 入力キーのレコードが存在するかどうか判断します。
レコードが 1 件も見つからなかった場合、ユーザープログラムはメッセージを発行します。 レコードが見つかった場合のユーザープログラムの処理内容は次のとおりです。
ファイル 1 からそのレコードを削除します
ファイル 2 に新しいレコード（フィールド RA= 入力された入力キー）を追加します。
その他のフィールドは空値にします。
レコードを正常に追加できない場合、ユーザープログラムは、BT コマンドを発行して、エラーメッセージを表示します。
両方とも正常に更新された場合、ユーザープログラムは ET コマンドを発行します。
プログラムのこのセクションは、ユーザーセッションの初期化中にのみ実行されます。
OP コマンドが発行されるときに、前回のセッションの ET データが読み込まれます。
メッセージが端末画面に表示され、前回のユーザーセッションで正常に完了した最後のトランザクションが通知されます。
EX3.
MOVE 'OP' TO COMMAND-CODE.
MOVE 'E' TO COMMAND-OPTION-2.
MOVE 'USER0002' TO ADDITIONS-1.
MOVE 'PASSWORD' TO ADDITIONS-3.
MOVE 'UPD=1,2.' TO RECORD-BUFFER.
CALL 'ADABAS' USING
CONTROL-BLOCK, FORMAT-BUFFER, RECORD-BUFFER.
IF RESPONSE-CODE = 9 GO TO EX3.
IF RESPONSE-CODE NOT EQUAL TO 0
GO TO EX3ERR.
EX3A.
MOVE COMMAND-ID TO COMM-ID.
IF COMM-ID-X = +0
GO TO EX3B.
* Display ET data (contained in RECORD BUFFER) on screen to inform user of
* last successfully processed transaction of previous user session.
. . .DISPLAY ET DATA. . .
GO TO EX3C.
EX3B.
*** No ET data received.
* Display message that no transactions were successfully processed during
* the previous user session
. . .DISPLAY MESSAGE . . .
*** Transaction processing.
* This section is executed for each user transaction.
EX3C.
* . . .ACCEPT INPUT FROM TERMINAL. . .
* Issue Find command for file 1 to determine if record exists with field AA
* equal to input key entered.
EX3D.
MOVE 'S4' TO COMMAND-CODE.
MOVE SPACES TO COMMAND-ID.
MOVE 1 TO FILE-NUMBER.
MOVE 0 TO ISN-LOWER-LIMIT.
MOVE '.' TO FORMAT-BUFFER.
MOVE 'AA.' TO SEARCH-BUFFER.
MOVE INPUT-KEY TO VALUE-BUFFER.
CALL 'ADABAS' USING
CONTROL-BLOCK, FORMAT-BUFFER, RECORD-BUFFER,
SEARCH-BUFFER, VALUE-BUFFER, ISN-BUFFER.
IF RESPONSE-CODE = 0
GO TO EX3E.
GO TO EX3ERR.
EX3E.
IF ISN-QUANTITY NOT EQUAL TO ZEROS
GO TO EX3F.
***No records found, issue message requesting correction.
. . .ISSUE MESSAGE . . .
GO TO EX3C.
*** Delete record from file 1.
* ISN of record to be deleted is already in ISN field and in hold
status
* as a result of the S4 command.
EX3F.
MOVE E3' TO COMMAND-CODE.
CALL 'ADABAS' USING CONTROL-BLOCK.
IF RESPONSE-CODE = 0
GO TO EX3G.
IF RESPONSE-CODE = 9
GO TO EX3D.
GO TO EX3ERR.
*** Add new record to file 2.
EX3G.
MOVE 'N1' TO COMMAND-CODE.
MOVE 2 TO FILE-NUMBER.
MOVE 'RA.' TO FORMAT-BUFFER.
MOVE INPUT-KEY TO RECORD-BUFFER.
CALL 'ADABAS' USING
CONTROL-BLOCK, FORMAT-BUFFER, RECORD-BUFFER.
IF RESPONSE-CODE = 0
GO TO EX3I.
IF RESPONSE-CODE = 9
GO TO EX3D.
*** Attempt to add new record not successful.
* Backout transaction.
* Notify user that error condition exists.
MOVE 'BT' TO COMMAND-CODE.
CALL 'ADABAS' USING control-block.
IF RESPONSE-CODE = 0
GO TO EX3H.
*** Backout not successful.
* Issue message indicating that the backout was not successful
GO TO EX3ERR.
EX3H.
*** Backout successful.
* Issue message indicating the error condition detected while while
adding a
* new record
GO TO EX3ERR.
*** Updates successfully executed.
* Issue ET command with ET data.
EX3I.
MOVE 'ET' TO COMMAND-CODE.
MOVE 'E' TO COMMAND-OPTION-2.
MOVE INPUT-KEY TO RECORD-BUFFER.
CALL 'ADABAS' USING
CONTROL-BLOCK, FORMAT-BUFFER, RECORD-BUFFER.
IF RESPONSE-CODE = 0
GO TO EX3C.
IF RESPONSE-CODE = 9
GO TO EX3D.
*** Error Routine
EX3ERR.
* . DISPLAY ERROR MESSAGE
* . TERMINATE USER PROGRAM
. . .
このセクションでは、PL/I での Adabas ダイレクトコールの使用例を示します。 各例では、以前に定義した Adabas ファイルを使用します。
/*** CONTROL BLOCK ***/
DCL 1 CONTROL_BLOCK,
02 FILLER1 CHAR (2) INIT (' '),
02 COMMAND_CODE CHAR (2) INIT (' '),
02 COMMAND_ID CHAR (4) INIT (' '),
02 FILE_NUMBER BIN FIXED (15) INIT (0),
02 RESPONSE_CODE BIN FIXED (15) INIT (0),
02 ISN BIN FIXED (31) INIT (0),
02 ISN_LOWER_LIMIT BIN FIXED (31) INIT (0),
02 ISN_QUANTITY BIN FIXED (31) INIT (0),
02 FORMAT_BUFFER_LENGTH BIN FIXED (15) INIT (100),
02 RECORD_BUFFER_LENGTH BIN FIXED (15) INIT (250),
02 SEARCH_BUFFER_LENGTH BIN FIXED (15) INIT (50),
02 VALUE_BUFFER_LENGTH BIN FIXED (15) INIT (100),
02 ISN_BUFFER_LENGTH BIN FIXED (15) INIT (20),
02 COMMAND_OPTION_1 CHAR(1) INIT (' '),
02 COMMAND_OPTION_2 CHAR(1) INIT (' '),
02 ADDITIONS_1 CHAR(8) INIT (' '),
02 ADDITIONS_2 CHAR(4) INIT (' '),
02 ADDITIONS_3 CHAR(8) INIT (' '),
02 ADDITIONS_4 CHAR(8) INIT (' '),
02 ADDITIONS_5 CHAR(8) INIT (' '),
02 COMMAND_TIME BIN FIXED (31) INIT (0),
02 USER_AREA CHAR(4) INIT (' ');
/*** USER BUFFER AREAS ***/
DCL FORMAT_BUFFER CHAR(100),
RECORD_BUFFER CHAR(250),
SEARCH_BUFFER CHAR(50),
VALUE_BUFFER CHAR(100),
ISN_BUFFER CHAR(20);
*
*
/*** ADDITIONAL FIELDS USED IN THE EXAMPLES ***/
DCL
COMM_ID_X BIN FIXED(31);
COMM_ID CHAR(4) BASED (ADDR(COMM_ID_X));
DCL INPUT_KEY CHAR(8);
DCL SYNC_CHECK_SWITCH CHAR(1) INIT('0');
DCL 1 RECORD_BUFFER_EX2,
2 RECORD_BUFFER_A CHAR(8),
2 RECORD_BUFFER_B DEC FIXED(3,0),
2 FILLER3 CHAR(240);
DCL 1 RECORD_BUFFER_EX3,
2 OPEN_RECORD_BUFFER,
3 OPEN_RECORD_BUFFER_X CHAR(8),
3 FILLER4 BIN FIXED(31),
2 FILLER5 CHAR(18),
2 UPDATED_XC CHAR(6),
2 LAST_XD CHAR(8),
2 FILLER6 CHAR(5),
1 USER_DATA,
2 RESTART_XD CHAR(8),
2 RESTART_ISN BIN FIXED(31);
DCL ADABAS ENTRY OPTIONS(ASM);
このセクションでは、次の例を記載しています。
XB=99 であるファイル 2 のレコードを検索します。
GET NEXT オプションを使って選択した各レコードを読みます。
*** Issue Open Command **/
EXMP1:
COMMAND_CODE = 'OP';
RECORD_BUFFER = 'ACC.';
CALL ADABAS (CONTROL_BLOCK,FORMAT_BUFFER,RECORD_BUFFER);
IF RESPONSE_CODE > 0 THEN GOTO EX1ERR;
/*** Issue Find Command ***/
COMMAND_CODE = 'S1';
COMMAND_ID = 'S101';
FILE_NUMBER = 2;
ISN_LOWER_LIMIT = 0;
ISN_BUFFER_LENGTH = 0;
FORMAT_BUFFER = '.';
SEARCH_BUFFER = 'XB,3,U.';
VALUE_BUFFER = '099';
CALL ADABAS (CONTROL_BLOCK, FORMAT_BUFFER,
RECORD_BUFFER, SEARCH_BUFFER, VALUE_BUFFER);
IF RESPONSE_CODE > 0 THEN GOTO EX1ERR;
EX1A:
IF ISN_QUANTITY = 0 THEN GOTO EX1EXIT;
EX1B:
COMMAND_CODE = 'L1';
ISN = 0;
COMMAND_OPTION_1 = 'N';
FORMAT_BUFFER = 'RG.';
EX1C:
CALL ADABAS (CONTROL_BLOCK,FORMAT_BUFFER,RECORD_BUFFER);
IF RESPONSE_CODE = 0 THEN
GOTO EX1D;
IF RESPONSE_CODE = 3 THEN
GOTO EX1EXIT;
EX1D:
. . .PROCESS RECORD . . .
GOTO EX1C;
/*** Error Routine ***/ EX1ERR: /* . DISPLAY ERROR MESSAGE */ /* . TERMINATE USER PROGRAM */
/** Issue Close Command **/
EX1EXIT:
COMMAND_CODE = 'CL';
CALL ADABAS (CONTROL_BLOCK);
IF RESPONSE_CODE > 0 THEN
GOTO EX1ERR;
ファイル 1 のレコードは、物理順に全部読み込まれます。
読み込んだ各レコードを次の値で更新します。
フィールド AA = ABCDEFGH
フィールド AB = 500
ユーザーは、ファイル 1 の排他制御権限を持つことが前提です。
/*** Issue Open Command ***/
EXMP2:
COMMAND_CODE = 'OP';
RECORD_BUFFER = 'EXU=1.';
CALL ADABAS (CONTROL_BLOCK,FORMAT_BUFFER,RECORD_BUFFER);
IF RESPONSE_CODE > 0 THEN GOTO EX2ERR;
/*** Issue Read Physical Seq. Command ***/
EX2A:
COMMAND_ID = 'L201';
FILE_NUMBER = 1;
ISN = 0;
FORMAT_BUFFER = 'GA.';
EX2B:
COMMAND_CODE = 'L2';
CALL ADABAS (CONTROL_BLOCK,FORMAT_BUFFER,RECORD_BUFFER);
IF RESPONSE_CODE = 0 THEN GOTO EX2C;
IF RESPONSE_CODE = 3 THEN GOTO EX2EXIT;
GOTO EX2ERR;
/*** Update record. ***/
/* Same fields are to be updated as were read. */
/* Same CID and FORMAT BUFFER can be used for update. */
/* ISN of record to be updated is already in ISN field as a result of */
/* the L2 command. */
EX2C:
COMMAND_CODE = 'A1';
RECORD_BUFFER_A = 'ABCDEFGH';
RECORD_BUFFER_B = 500;
CALL ADABAS (CONTROL_BLOCK,FORMAT_BUFFER,
RECORD_BUFFER_EX2);
IF RESPONSE_CODE > 0 THEN GOTO EX2ERR;
GOTO EX2B;
/*** Error Routine ***/ EX2ERR: /* . DISPLAY ERROR MESSAGE */ /* . TERMINATE USER PROGRAM */
/* Close User Session */
EX2EXIT:
COMMAND_CODE = 'CL';
CALL ADABAS (CONTROL_BLOCK);
IF RESPONSE_CODE > 0 THEN GOTO EX2ERR;
この例は、ET ロジックでのユーザーセッションを示します。 ユーザープログラムは次の機能を実行します。
ユーザーセッションの初期化中に、前回のユーザーセッションで最後に正常に処理したトランザクションに関する情報を表示します。
ユーザートランザクションごとに次のことを行います。
ファイル 1 と 2 の更新用のキーとして使用される 8 文字の入力を端末から受け入れます。
ファイル 1 に対して FIND コマンドを発行し、フィールド AA= 入力キーのレコードが存在するかどうか判断します。
レコードが 1 件も見つからなかった場合は、メッセージを発行します。
レコードが見つかった場合：
ファイル 1 からレコードを削除します。
ファイル 2 に新しいレコードを追加します。フィールド RA= 入力キーを入力し、 その他のフィールドは空値にします。
レコードを正常に追加できない場合は、BT コマンドを発行して、エラーメッセージを表示します。
更新が正常に終了した場合は、ET コマンドを発行します。
プログラムのこのセクションは、ユーザーセッションの初期化中にのみ実行されます。
OP コマンドが発行されるときに、前回のセッションの ET データが読み込まれます。
メッセージが端末画面に表示され、前回のユーザーセッションで正常に完了した最後のトランザクションが通知されます。
EX3:
COMMAND_CODE = 'OP';
COMMAND_OPTION_2 = 'E';
ADDITIONS_1 = 'USER0003';
ADDITIONS_3 = 'PASSWORD';
RECORD_BUFFER = 'UPD=1,2.';
CALL ADABAS (CONTROL_BLOCK,FORMAT_BUFFER,RECORD_BUFFER);
IF RESPONSE_CODE = 9 THEN GOTO EX3;
IF RESPONSE_CODE > 0 THEN
GOTO EX3ERR;
EX3A:
COMM_ID = COMMAND_ID;
IF COMM_ID_X = 0 THEN
GOTO EX3B;
/* Display ET data (contained in RECORD BUFFER) on screen to inform user of
last successfully processed transaction of previous user session. */
. . .DISPLAY ET DATA. . .
GOTO EX3C;
EX3B:
/* */
/*** No ET data received. */
/* Display message that no transactions were successfully processed during
the previous user session. */
. . .DISPLAY MESSAGE . . .
/* */
/*** Transaction processing. ***/
/* This section is executed for each user transaction. */
EX3C:
. . .ACCEPT INPUT FROM TERMINAL. . .
/* */
/* Issue Find command for file 1 to determine if rec exists with field AA
equal to input key entered. */
EX3D:
COMMAND_CODE = 'S4';
COMMAND_ID = ' ';
FILE_NUMBER = 1;
ISN_LOWER_LIMIT = 0;
FORMAT_BUFFER = '.';
SEARCH_BUFFER = 'AA.';
VALUE_BUFFER = INPUT_KEY;
CALL ADABAS (CONTROL_BLOCK,FORMAT_BUFFER,RECORD_BUFFER,
SEARCH_BUFFER,VALUE_BUFFER,ISN_BUFFER);
IF RESPONSE_CODE = 0 THEN
GOTO EX3E;
GOTO EX3ERR;
EX3E:
IF ISN_QUANTITY > 0 THEN
GOTO EX3F;
/* */
/* No record found, issue message requesting correction. */
. . .ISSUE MESSAGE . . .
GOTO EX3C;
/* */
/* Delete record from file 1. */
/* ISN of record to be deleted is already in ISN field and in hold
status
as a result of the S4 command. */
EX3F:
COMMAND_CODE = 'E4';
CALL ADABAS (CONTROL_BLOCK);
IF RESPONSE_CODE = 0 THEN
GOTO EX3G;
IF RESPONSE_CODE = 9 THEN
GOTO EX3D;
GOTO EX3ERR;
/***Add new record to file 2. */
EX3G:
COMMAND_CODE = 'N1';
FILE_NUMBER = 2;
FORMAT_BUFFER = 'RA.';
RECORD_BUFFER = INPUT_KEY;
CALL ADABAS (CONTROL_BLOCK,FORMAT_BUFFER,RECORD_BUFFER);
IF RESPONSE_CODE = 0 THEN
GOTO EX3I;
IF RESPONSE_CODE = 9 THEN
GOTO EX3D;
/* */
/* Attempt to add new record not successful. Backout transaction and
notify
user that error condition exists. */
COMMAND_CODE = 'BT';
CALL ADABAS (CONTROL_BLOCK);
IF RESPONSE_CODE = 0 THEN
GOTO EX3H;
/* */
/* Backout not successful. */
. . .ISSUE MESSAGE INDICATING BACKOUT NOT SUCCESSFUL . .
GO TO EX3ERR.
/* */
EX3H:
/*** Backout successful. ***/
/* Issue message indicating error condition detected while adding new
record.*/
. . .ISSUE MESSAGE. . .
GOTO EX3ERR;
/* */
/*** Updates successfully executed. ***/
/* Issue ET command with ET data. */
EX3I:
COMMAND_CODE = 'ET';
COMMAND_OPTION_2 = 'E';
RECORD_BUFFER = INPUT_KEY;
CALL ADABAS (CONTROL_BLOCK,FORMAT_BUFFER,RECORD_BUFFER);
IF RESPONSE_CODE = 0 THEN
GOTO EX3C;
IF RESPONSE_CODE = 9 THEN
GOTO EX3D;
/* */
/*** Error Routine ***/
EX3ERR:
/* . DISPLAY ERROR MESSAGE */
/* . TERMINATE USER PROGRAM */
. . .
このセクションでは、FORTRAN での Adabas ダイレクトコールの使用例を示します。 各例では、以前に定義した Adabas ファイルを使用します。
C *** CONTROL BLOCK ***
INTEGER*4 CB(20),CID,ISN,ISNL,ISNQ
INTEGER*4 ADD1(2),ADD2,ADD3(2),ADD4(2),ADD5(2)
INTEGER*4 CTIME,UAREA
INTEGER*2 CBI(40),CCODE,FNR,RC,FBL,RBL,SBL,VBL,IBL
LOGICAL*1 CBL(80),COPT1,COPT2
EQUIVALENCE (CB(1),CBI(1),CBL(1))
EQUIVALENCE (CID,CB(2)),(ISN,CB(4))
EQUIVALENCE (ISNL,CB(5)),(ISNQ,CB(6))
EQUIVALENCE (ADD1(1),CB(10)),(ADD2,CB(12)),(ADD3(1),CB(13))
EQUIVALENCE (ADD4(1),CB(15),(ADD5(1),CB(17))
EQUIVALENCE (CTIME,CB(19)),(UAREA,CB(20))
EQUIVALENCE (CCODE,CBI(2)),(FNR,CBI(5)),(RC,CBI(6))
EQUIVALENCE (FBL,CBI(13)),(RBL,CBI(14)),(SBL,CBI(15))
EQUIVALENCE (VBL,CBI(16)),(IBL,CBI(17))
EQUIVALENCE (COPT1,CBL(35)),(COPT2,CBL(36))
C *** USER BUFFER AREAS ***
INTEGER*4 FB(25),RB(50),SB(10),VB(10),IB(50)
*
*
C *** ADDITIONAL FIELDS USED IN THIS EXAMPLE ***
LOGICAL*1 BLANK/1H /,COPH/1HH/,PERIOD/1H./,COPN/1HN/
INTEGER*2 S1/2HS1/,L1/2HL1/,CL/2HCL/
INTEGER*4 CID1/4HS101/,FB1/4H. /,FB2/4HRG. /,SB1/4HXB,3/
INTEGER*4 SB2/4H,U. /,VB1/4H099 /
このセクションでは、次の例を記載しています。
XB=99 であるファイル 2 のレコードを検索します。
GET NEXT オプションを使って選択した各レコードを読みます。
c*** Initialize Control Block
DO 5 I=1,80
CBL(I)=BLANK
5 CONTINUE
DO 10 I=3,6
CB(I)=0
10 CONTINUE
CBI(13)=100
CBI(14)=200
CBI(15)=40
CBI(16)=40
CBI(17)=200
CBI(19)=0
c***Issue FIND Command
CCODE=S1
CID=CID1
FNR=2
ISNL=0
COPT1=COPH
FB(1)=FB1
SB(1)=SB1
SB(2)=SB2
VB(1)=VB1
CALL ADABAS(CB,FB,RB,SB,VB,IB)
IF(RC.NE.0) GO TO 50
IF(ISNQ.EQ.0) GO TO 100
c***Read Each Record Selected
15 CONTINUE
CCODE=L1
ISN=0
COPT1=COPN
FB(1)=FB2
CALL ADABAS(CB,FB,RB)
IF(RC.EQ.0) GO TO 30
IF(RC.EQ.3) GO TO 100
PRINT 60,RC,CCODE
60 FORMAT(1H0,'ADABAS ERROR CODE',I4,' FROM '.A2,' COMMAND')
GO TO 50
30 CONTINUE
C ...PROCESS RECORD...
GO TO 15
50 CONTINUE
STOP
100 CONTINUE
...