AS400範例程式撰寫過程 步驟1：建立Display File 靜宜大學資管系 楊子青 2006.1.4.

CRTLIB指令建立edu47ex的Library

EDTLIBL指令將edu47ex加入 Library List。按enter，再按F3

CRTSRCPF指令建立QDDSSRC的 原始檔(存放DDS相關內容)

STRPDM指令，選3 填入QDDSSRC相關資料

按F6，可新增Member及進行編輯 (例如LABDS這個display file)

LABDS原始碼 (LAB1讓使用者輸入實驗室編號) (LAB2讓使用者輸入名稱及分機) (LAB3顯示名稱及分機之查詢結果) /* ******************************************************************/ A DSPSIZ(24 80 *DS3) A PRINT A CA03(03 'EXIT') A************************************************ A*主要畫面　　　　　　　 A R LAB1 A OVERLAY A 3 20'實驗室編號：' A 5 20'實驗室名稱：' A 7 20'實驗室分機：' A LAB1_LABNO 5A B 3 50DSPATR(PC) A DSPATR(RI) A DSPATR(UL) A R LAB2 A CLRL(*NO) A LAB2_LABNM 20A B 5 50DSPATR(PC) A LAB2_LABTL 5A B 7 50DSPATR(PC) A R LAB3 A LAB3_LABNM 20A B 5 50 A LAB3_LABTL 5A B 7 50 (LAB1讓使用者輸入實驗室編號) (LAB2讓使用者輸入名稱及分機) (LAB3顯示名稱及分機之查詢結果)

原始碼編輯後，按F3， change/ create member選y，即可存檔

原始碼前，輸入14進行compile

WRKSPLF指令，檔案前選5可查詢編譯結果 (page down最後一行顯示是否成功)

DSPLIB edu47ex指令查詢library， 會出現LABDS這個檔案

STRSDA指令，選3，填入以下資料 可觀看該Record所定義之畫面

步驟2：建立Physical File 靜宜大學資管系 楊子青 2006.1.4.

STRPDM指令，選3，填入QDDSSRC相關資料。按F6，新增LABDB之physical file)

編輯後，按F3存檔，再選14 進行compile LABDB原始碼 (定義了三個欄位) A UNIQUE A R LABDATA TEXT('實驗室資料欄位') A LABNO 5A COLHDG('實驗室編號') A LABNAME 20A COLHDG('實驗室名稱') A LABTEL 5A COLHDG('實驗室分機') A K LABNO 編輯後，按F3存檔，再選14 進行compile

DSPFD指令，按F4，輸入File及library， 可查詢該檔案之描述

DSPFFD指令，按F4，輸入File及library， 可查詢該檔案之資料庫架構

DSPPFM edu47ex/labdb指令， 可查詢資料庫內容

步驟3：建立RPG program 靜宜大學資管系 楊子青 2006.1.4.

CRTSRCPF指令建立QRPGLESRC的 原始檔(存放RPG相關程式碼)

STRPDM指令，選3 填入QRPGLESRC相關資料 按F6，可新增Member及進行編輯 (例如Project1~Project5這些RPG程式) (SourceType為RPGLE)

Project1原始碼(程式版本1) F***************************************************************** Flabds CF E WORKSTN Flabdb UF A E K DISK C DOU LAB1_LABNO='00000' C exfmt lab1 C ENDDO C EVAL *INLR=*ON C return (讓使用者輸入實驗室編號，若輸入00000則結束程式)

Project2原始碼(程式版本2) F***************************************************************** Flabds CF E WORKSTN Flabdb UF A E K DISK C DOU LAB1_LABNO='00000' C EXFMT LAB1 C EVAL LABNO=LAB1_LABNO C WRITE LABDATA C ENDDO C EVAL *INLR=*ON C RETURN (讓使用者輸入實驗室編號，並寫入資料庫中) (此支程式完全不檢查是否該編號已存在資料庫中，因此若輸入重複 的編號如00001，程式會產生error而結束)

Project3原始碼(程式版本3) F***************************************************************** Flabds CF E WORKSTN Flabdb UF A E K DISK C DOU LAB1_LABNO='00000' C EXFMT LAB1 C EVAL LABNO=LAB1_LABNO C LABNO CHAIN LABDATA C IF NOT %FOUND(LABDB) C WRITE LABDATA C ENDIF C ENDDO C EVAL *INLR=*ON C RETURN (改進版本2，輸入不重複的編號才會寫入資料庫) (程式執行前後，請用dsppfm edu47ex/labdb指令看有何不同)

Project4原始碼(程式版本4， 新增資料完整版本) F***************************************************************** Flabds CF E WORKSTN Flabdb UF A E K DISK C DOU LAB1_LABNO='00000' C EXFMT LAB1 C EVAL LABNO=LAB1_LABNO C LABNO CHAIN LABDATA C IF NOT %FOUND(LABDB) C EXFMT LAB2 C EVAL LABNAME=LAB2_LABNM C EVAL LABTEL=LAB2_LABTL C WRITE LABDATA C ENDIF C ENDDO C EVAL *INLR=*ON C RETURN (改進版本3，輸入不重複的編號後，才可繼續輸入實驗室編號及電話，最後再新增於資料庫中)

Project5原始碼(程式版本5， 查詢資料完整版本) F***************************************************************** Flabds CF E WORKSTN Flabdb UF A E K DISK C DOU LAB1_LABNO='00000' C EXFMT LAB1 C EVAL LABNO=LAB1_LABNO C LABNO CHAIN LABDATA C IF %FOUND(LABDB) C EVAL LAB3_LABNM=LABNAME C EVAL LAB3_LABTL=LABTEL C EXFMT LAB3 C ENDIF C ENDDO C EVAL *INLR=*ON C RETURN (輸入編號如m232, m228, 或m226a後， 會顯示實驗室編號及電話)

CRTBNDRPG指令，按F4， 進行程式編譯

CALL edu47ex/project1指令，可執行程式

步驟4：建立MENU 靜宜大學資管系 楊子青 2006.1.4.

STRPDM指令，選3 填入QDDSSRC相關資料 按F6，新增MENUPJ之display file 存檔後，按14進行compile A HOME(01 'HOME MENU') A CA03(03 'EXIT') A CA12(12 'PREVIOUS') A INDARA A R MENU A 2 70'MENU' A COLOR(BLU) A 6 5' 1.新增實驗室資料' A 8 5' 2.查詢實驗室資料' A 20 5'99. SIGN OFF' A 23 2'SELECT :' A OPT 2 I 23 12DSPATR(PC)

CRTSRCPF指令建立QCLSRC的 原始檔(存放Control Language程式碼)

STRPDM指令，選3 填入QCLSRC相關資料 按F6，可新增Member及進行編輯 (新增MENUPJRPG之CLLE程式 作為主選單)

MENUPJRPG原始碼 pgm parm(&menu &lib &act) dcl &menu *char len(10) dcl &lib *char len(10) dcl &act *char len(2) dclf file(menupj) rcdfmt(menu) sndrcvf rcdfmt(menu) chgvar &act value(X'0000') /* menu display again */ if cond(&in01 = '1') then(chgvar &act value(X'FFFC')) /* home */ if cond(&in03 = '1') then(chgvar &act value(X'FFFF')) /* exit */ if cond(&in12 = '1') then(chgvar &act value(X'FFFE')) /* previous */ if cond(&opt = '1') then(call project4) if cond(&opt = '2') then(call project5) if cond(&opt = '99') then(signoff) endpgm

CRTBNDCL指令，按F4， 進行CL程式編譯(產生*pgm檔)

CRTMNU指令，按F4，再按F10填入資料 (menu type為*pgm)，產生選單(*menu)

GO MenuPjRPG指令，可執行該選單