課程07-TIPTOP GP單檔作業

1、TIPTOP GP 教育訓練單檔作業程式本教材以 TIPTOP GP 2.0 版為說明標準程式分類i、t、s類等一筆資料 aoos010單檔維護 aooi010單檔多欄 aooi040假雙檔 p_perlang雙檔 apmi252多檔 asfi301報表或批次程式類 ( p、r 類) 查詢類 ( q 類 )學習目標本章說明單檔維護標準程式。所謂單檔：是指使用單一檔案來記錄某一主檔資料，或是參考值資料等之檔案。學習完本章後，你將可以了解以下局部: 控制流程及各個函數間之關係。 如何使用共用 lib 函式及相關應用時機之比較。 使用INPUT指令來處理各欄位資料。單檔流程圖menuMAINu()q

2、()F/N/P/Lcopy()r()x()out()show()cs()fetch()u()show()show()rep()i()fetch()a()i()show()delh()程式畫面共用及模組變數宣告本段應瞭解重點GLOBALS “././假设非所有TIPTOP GP程式均會用到的全域變數，則應該於每支程式中自行指定。 # Prog. Version.: 2.00.01-05.11.29(00004) # Descriptions.: 簽核人員# Date & Author.: 91/04/11 By Lee# Modify: No:MOD-470515 04/10/05 By Nic

3、ola 参加相關文件功能DATABASE dsGLOBALS ././共用及模組變數宣告 (1)共用及模組變數宣告 (2)DEFINE g_azb RECORD LIKE azb_file.*, g_azb_t RECORD LIKE azb_file.*, #備份舊值 g_azb01_t LIKE azb_file.azb01, #Key值備份 g_wc STRING, #儲存 user 的查詢條件 g_sql STRING, #組 sql 用 g_azb_rowid CHAR(18) #ROWID使用DEFINE g_forupd_sql STRING #SELECT . FOR UPDA

4、TE NOWAIT SQLDEFINE g_before_input_done SMALLINT #判斷是否已執行 Before Input指令DEFINE g_chr VARCHAR(1)DEFINE g_cnt INTEGERDEFINE g_i SMALLINT #count/index for any purposeDEFINE g_msg VARCHAR(72)DEFINE g_curs_index INTEGERDEFINE g_row_count INTEGER #總筆數DEFINE g_jump INTEGER #查詢指定的筆數DEFINE g_no_ask SMALLINT

5、#是否開啟指定筆視窗MAIN本段應瞭解重點程式開始前，需將外部引數讀入以程式所屬的畫面style開啟視窗WHENEVER ERROR CALL cl_err_msg_loglock cursor寫法menu以key值轉換其他語言MAIN DEFINE p_row,p_col SMALLINT, l_time VARCHAR(8) OPTIONS FORM LINE FIRST + 2, #畫面開始的位置 MESSAGE LINE LAST, #訊息顯示的位置 PROMPT LINE LAST, #提示訊息的位置 INPUT NO WRAP #輸入的方式: 不打轉 DEFER INTERRUPT

6、 #擷取中斷鍵 LET p_row = ARG_VAL(1) LET p_col = ARG_VAL(2) IF (NOT cl_user() THEN EXIT PROGRAM END IF WHENEVER ERROR CALL cl_err_msg_logmain (1)在系統設定 OPTIONS後就應讀入外部參數ARG_VAL( 參數位置 )cl_user( ) 主要在抓取系統中與個人設定相關的變數值資料，如g_user，g_clas，g_grup等等。當發生 SQL 錯誤時，系統會CALL cl_err_msg_log( ) 注意此處 CALL 的寫法與他處不同，不可加括號main

7、(2) IF (NOT cl_setup(AOO) THEN EXIT PROGRAM END IF CALL cl_used(g_prog,l_time,1) RETURNING l_time INITIALIZE g_azb.* TO NULL LET g_forupd_sql = SELECT * FROM azb_file WHERE ROWID = ? FOR UPDATE NOWAIT DECLARE i010_cl CURSOR FROM g_forupd_sql # LOCK CURSOR OPEN WINDOW i010_w AT p_row,p_col WITH FORM

8、aoo/42f/aooi010 ATTRIBUTE (STYLE = g_win_style CLIPPED) CALL cl_ui_init() LET g_action_choice = CALL i010_menu() CLOSE WINDOW i010_w CALL cl_used(g_prog,l_time,2) RETURNING l_timeEND MAINcl_setup( ) 主要在抓取系統中與模組設定相關的變數值資料，如這個模組所必需的全域變數等等。需要傳入模組代碼。客製時需要一併修改模組代碼，系統會自動與 p_zz 中本程式所屬模組比對。一個作業只需要在主程式處呼叫乙次即

9、可。cl_used 主要在記錄使用者使用本作業的時間，是否記錄決定於 aoos010，記錄資料可用 p_used 檢視或用 aoor010 列印使用狀況報表開啟時用 STYLE = g_win_style CLIPPED(固定用法) 。由於 g_win_style 在 cl_setup 中會抓取 p_zz 的設定，故可達到動態改變外觀之功能。此作業應成對出現，應傳入主作業代碼、現在時間、開啟或結束代碼作業的主要畫面通常是第一個開啟的畫面，後面使用 CALL cl_ui_init( ) 不傳參數其他的次要畫面，就只使用 CALL cl_ui_locale( “畫面代碼 )兩者差別在讀入 Tool

10、Bar 等環境設定一般我們會要求在作OPEN WINDOW的函式中就必需要在離開前做 CLOSE WINDOW的工作MAIN函式也一樣。單檔選單畫面本段應瞭解重點利用 MENU-ON ACTION 結構執行使用者按下的功能menu段的g_action_choice名稱要與4ad對應；假设有非標準的action name，也要與程式自有4ad內的名稱相同權限判斷，利用call cl_chk_act_auth()各Action內容_menu (1)FUNCTION i010_menu() DEFINE l_cmd VARCHAR(100) MENU BEFORE MENU CALL cl_navi

11、gator_setting(g_curs_index, g_row_count) ON ACTION insert LET g_action_choice=insert IF cl_chk_act_auth() THEN CALL i010_a() END IF ON ACTION query LET g_action_choice=query IF cl_chk_act_auth() THEN CALL i010_q() END IFcl_navigator_setting( g_curs_index, g_row_count) 主要用在重新設定TOOLBAR上的上筆、跳筆、下筆等五個按鍵是

12、否可用 / 不可用。此寫法為固定寫法，系統藉由操作 g_curs_index (現在在哪一筆) 、g_row_count(總共有幾筆) 來定義是否可用那一些按鍵系統使用 cl_chk_act_auth( )函式來判斷執行使用者 (g_user) 所屬的群組 (g_grup) 在本作業 (g_prog) 是否有可執行的權利或作業項目。也會一併判斷特殊案例，如是否與資料有關等。利用 g_action_choice 告知要判斷的權限項目。系統會偵測是否有寫 LET g_action_choice = “act_id ，假设沒寫則系統預設此項不作權限控管。如果不欲顯示出無權限的錯誤訊息，則可以呼叫 c

13、l_chk_act_auth_nomsg( ) 抑制錯誤訊息的出現 _menu (2) ON ACTION first CALL i010_fetch(F) ON ACTION jump CALL i010_fetch(/) ON ACTION last CALL i010_fetch(L) ON ACTION related_document LET g_action_choice=related_document IF cl_chk_act_auth() THEN IF g_azb.azb01 IS NOT NULL THEN LET g_doc.column1 = azb01 CALL

14、cl_doc() END IF END IFTIPTOP系統中使用標準 action-id，其中 first、pervious、jump、next、last分別代表第一筆、前一筆、指定筆、下一筆及最後一筆以上五個action不作權限控管相關文件請命名為 “related_document相關文件請用 CALL cl_doc( ) 開啟相關文件至少需傳入一組 column 及 values相關文件至多可以傳入五組 column 及 values_menu (3) ON ACTION controlg CALL cl_cmdask() ON ACTION help CALL cl_show_hel

15、p() ON ACTION about CALL cl_about() ON IDLE g_idle_seconds CALL cl_on_idle() CONTINUE MENU ON ACTION locale CALL cl_dynamic_locale() CALL cl_show_fld_cont() 功能controlg 為提供在作業中可以另外再開一個執行作業的函式只要 CALL cl_cmdask( ) 即可本功能不外顯在 ring menu 上，以熱鍵 Control G 驅動欲限制本功能可參考系統管理Help 為提供一個 html 格式的說明文件，按入後會以瀏覽器開啟本函式不

16、傳參數，系統自動尋找文件位置 (與 p_zz相關)本Action出現於 toolbar處提供一個系統說明視窗，說明版本別、製作商及部份重要環境變數等。直接 CALL cl_about( ) 即可本 Action 出現於 TopMenuON IDLE 主要在控制使用者是否閒置時間過長假设到達後方設定秒數，系統則執行此區段g_idle_seconds 為設定於相關作業cl_on_idle( ) 會讀取相關設定確認是否該關閉作業或僅顯示訊息cl_dynamic_locale( ) 主要在出現語言選單以供使用者選擇需要變更到哪一個語系下顯示，同時會一併更正此使用者常用語言別cl_show_fld_co

17、nt( ) 主要在設定畫面 comment (show hint) 處文字，該文字依照 p_per 中資料設定。右側這四個項目，為與使用者進行交談時所必需給予的標準功能及標準限制，後序於INPUT、MENUCONSTRUCT、PROMPT或DISPLAY ARRAY均需給予。 ON ACTION cancel #No:MOD-470400 LET g_action_choice = exit EXIT MENU ON ACTION exit LET g_action_choice = exit EXIT MENU COMMAND KEY(INTERRUPT) LET INT_FLAG=FALS

18、E LET g_action_choice = exit EXIT MENU END MENU CLOSE i010_csEND FUNCTION_menu (4)左側三個項目都是離開，分別作用於不同種類的指令中，以下分類說明。ON ACTION cancel當指令為 DISPLAY ARRAT 時，此action 預設為右上方 x 按鍵ON ACTION exit標準的離開功能COMMAND KEY (INTERRUPT)使用 MENU 指令時，右上方的 X 即為此 COMMAND KEY。單檔流程圖menuMAINu()q()F/N/P/Lcopy()r()x()out()show()cs

19、()fetch()u()show()show()rep()i()fetch()a()i()show()delh()查詢流程畫面初始化清空畫面上資料。CLEAR FORM去除畫面資料資料總筆數：g_row_count；指標：g_curs_index預設上下筆Button狀態q()cs()fetch()show()_q( )本段應瞭解重點做查詢開始前的準備分配工作給後續其他函式處理放棄按鍵_q (1)FUNCTION i010_q() LET g_row_count = 0 LET g_curs_index = 0 CALL cl_navigator_setting(g_curs_index,g_

20、row_count) MESSAGE CALL cl_opmsg(q) DISPLAY TO CALL i010_curs() # 宣告 SCROLL CURSOR IF INT_FLAG THEN LET INT_FLAG = 0 CLEAR FORM RETURN END IF_cs( ) 或 _curs( )本段應瞭解重點CONSTRUCT 查詢資料開窗查詢程式g_qryparam變數說明Count使用g_row_count變數_cs (1)FUNCTION i010_curs() CLEAR FORM CONSTRUCT BY NAME g_wc ON azb01,azb02,azb0

21、6, # 螢幕上取條件 azbuser,azbgrup,azbmodu,azbdate,azbacti ON ACTION controlp CASE WHEN INFIELD(azb01) CALL cl_init_qry_var() LET = q_gen LET = c CALL cl_create_qry() RETURNING DISPLAY TO azb01 NEXT FIELD azb01 OTHERWISE EXIT CASE END CASE_cs (2) ON IDLE g_idle_seconds CALL cl_on_idle() CONTINUE CONSTRUCT

22、ON ACTION about #MOD-4C0121 CALL cl_about() #MOD-4C0121 ON ACTION help #MOD-4C0121 CALL cl_show_help() #MOD-4C0121 ON ACTION controlg #MOD-4C0121 CALL cl_cmdask() #MOD-4C0121 END CONSTRUCT_cs (3) #資料權限的檢查 IF g_priv2=4 THEN #只能使用自己的資料 LET g_wc = g_wc CLIPPED, AND azbuser = ,g_user, END IF IF g_priv3=

23、4 THEN #只能使用相同群的資料 LET g_wc = g_wc CLIPPED, AND azbgrup MATCHES , g_grup CLIPPED,* END IF LET g_sql=SELECT ROWID,azb01 FROM azb_file , # 組合出 SQL 指令 WHERE ,g_wc CLIPPED, ORDER BY azb01 PREPARE i010_prepare FROM g_sql DECLARE i010_cs # SCROLL CURSOR SCROLL CURSOR WITH HOLD FOR i010_prepare LET g_sql=

24、SELECT COUNT(*) FROM azb_file WHERE ,g_wc CLIPPED PREPARE i010_precount FROM g_sql DECLARE i010_count CURSOR FOR i010_precountEND FUNCTION_q (1)FUNCTION i010_q() LET g_row_count = 0 LET g_curs_index = 0 CALL cl_navigator_setting(g_curs_index,g_row_count) MESSAGE CALL cl_opmsg(q) DISPLAY TO CALL i010

25、_curs() # 宣告 SCROLL CURSOR IF INT_FLAG THEN LET INT_FLAG = 0 CLEAR FORM RETURN END IF_q (2) OPEN i010_count FETCH i010_count INTO g_row_count DISPLAY g_row_count TO OPEN i010_cs # 從DB產生符合條件TEMP(0-30秒) IF THEN CALL cl_err(g_azb.azb01,SQLCA.sqlcode,0) INITIALIZE g_azb.* TO NULL ELSE CALL i010_fetch(F)

26、 # 讀出TEMP第一筆並顯示 END IFEND FUNCTION_fetch()本段應瞭解重點分別傳入N、P、F、L、/，以供下筆、上筆、第一筆、末一筆、跳筆功能使用在跳筆功能的地方，以變數區隔是否要開視窗給使用者輸入筆數Fetch無誤後，以目前所在筆數及總筆數控制上下筆button是否顯現_fetch (1)FUNCTION i010_fetch(p_flazb) DEFINE p_flazb VARCHAR(1) CASE p_flazb WHEN / IF (NOT g_no_ask) THEN CALL cl_getmsg(fetch,g_lang) RETURNING g_msg

27、 LET INT_FLAG = 0 #add for prompt bug_fetch (2) PROMPT g_msg CLIPPED,: FOR g_jump ON IDLE g_idle_seconds CALL cl_on_idle() ON ACTION about #MOD-4C0121 CALL cl_about() #MOD-4C0121 ON ACTION help #MOD-4C0121 CALL cl_show_help() #MOD-4C0121 ON ACTION controlg #MOD-4C0121 CALL cl_cmdask() #MOD-4C0121 EN

28、D PROMPT IF INT_FLAG THEN LET INT_FLAG = 0 EXIT CASE END IF END IF_fetch (3) FETCH ABSOLUTE g_jump LET g_no_ask = FALSE END CASE IF THEN CALL cl_err(g_azb.azb01,SQLCA.sqlcode,0) RETURN ELSE CASE p_flazb WHEN F LET g_curs_index = 1 WHEN P LET g_curs_index = g_curs_index - 1 WHEN N LET g_curs_index =

29、g_curs_index + 1 WHEN L LET g_curs_index = g_row_count WHEN / LET g_curs_index = g_jump END CASE CALL cl_navigator_setting(g_curs_index, g_row_count) DISPLAY g_curs_index TO #No:FUN-4A0089 END IF_fetch (4) SELECT * INTO g_azb.* FROM azb_file # 重讀DB,因TEMP有不被更新特性 WHERE ROWID = g_azb_rowid IF THEN CALL

30、 cl_err(g_azb.azb01,SQLCA.sqlcode,0) ELSE LET g_data_owner= #FUN-4C0044權限控管 LET g_data_group= CALL i010_show() # 重新顯示 END IFEND FUNCTION_show()本段應瞭解重點_show()顯示資料_show (1)FUNCTION i010_show() LET g_azb_t.* = g_azb.* DISPLAY BY NAME g_azb.* CALL i010_azb01(d) CALL cl_show_fld_cont() #No:FUN-550037 hmf

31、END FUNCTION單檔流程圖menuMAINu()q()F/N/P/Lcopy()r()x()out()show()cs()fetch()u()show()show()rep()i()fetch()a()i()show()delh()新增流程a()i()本段應瞭解重點新增前將資料清空；設定預設值_a( )_a (1)FUNCTION i010_a() MESSAGE CLEAR FORM # 清螢幕欄位內容 INITIALIZE g_azb.* LIKE azb_file.* LET g_azb01_t = NULL LET g_wc = NULL CALL cl_opmsg(a) WH

32、ILE TRUE LET = g_user LET = g_grup #使用者所屬群 LET = g_today LET = Y CALL i010_i(a) # 各欄位輸入 IF INT_FLAG THEN # 假设按了DEL鍵 INITIALIZE g_azb.* TO NULL LET INT_FLAG = 0 CALL cl_err(,9001,0) CLEAR FORM EXIT WHILE END IF_i( )本段應瞭解重點欄位控制的function要加在BEFORE INPUT內，及條件欄位的BEFORE FIELD跟AFTER FIELD欄位控制寫法及邏輯各AFTER FIE

33、LD：欄位非空白才檢查欄位正確性_i( ) 其他ACTION本段應瞭解重點CONTROLO：回復舊值CONTROLP：開窗查詢CONTROLZ：必要輸入欄位CONTROLF：開啟欄位說明ON IDLE：其他地方(construct段、input段、display段、prompt段)CONTROLG：執行外部指令_i (1)FUNCTION i010_i(p_cmd) DEFINE p_cmd VARCHAR(1), l_gen02 LIKE gen_file.gen02, l_gen03 LIKE gen_file.gen03, l_gen04 LIKE gen_file.gen04, l_g

34、em02 LIKE gem_file.gem02, l_input VARCHAR(1), l_n SMALLINT INPUT BY NAME g_azb.azb01,g_azb.azb02,g_azb.azb06, , WITHOUT DEFAULTS_i (2) AFTER FIELD azb01 IF NOT cl_null(g_azb.azb01) THEN IF p_cmd = a OR # 假设輸入或更改且改KEY (p_cmd = u AND g_azb.azb01 != g_azb01_t) THEN SELECT count(*) INTO l_n FROM azb_fil

35、e IF l_n 0 THEN # Duplicated CALL cl_err(g_azb.azb01,-239,1) LET g_azb.azb01 = g_azb01_t NEXT FIELD azb01 END IF CALL i010_azb01(a) IF NOT cl_null(g_errno) THEN CALL cl_err(azb01:,g_errno,1) LET g_azb.azb01 = g_azb01_t NEXT FIELD azb01 END IF END IF END IF_i (3) BEFORE INPUT LET l_input=N LET g_befo

36、re_input_done = FALSE CALL i010_set_entry(p_cmd) CALL i010_set_no_entry(p_cmd) LET g_before_input_done = TRUE AFTER INPUT IF INT_FLAG THEN EXIT INPUT END IF IF g_azb.azb01 IS NULL THEN LET l_input=Y END IF IF l_input=Y THEN NEXT FIELD azb01 END IF_i (4) ON ACTION controlp CASE WHEN INFIELD(azb01) CA

37、LL cl_init_qry_var() LET = q_gen CALL cl_create_qry NEXT FIELD azb01 OTHERWISE EXIT CASE END CASE ON IDLE g_idle_seconds CALL cl_on_idle() CONTINUE INPUT_i (5) ON ACTION CONTROLZ CALL cl_show_req_fields() ON ACTION CONTROLF # 欄位說明 CALL () RETURNING g_fld_name CALL cl_fldhelp(g_frm_name,g_fld_name,g_

38、lang) ON ACTION about #MOD-4C0121 CALL cl_about() #MOD-4C0121 ON ACTION help #MOD-4C0121 CALL cl_show_help() #MOD-4C0121 ON ACTION CONTROLG CALL cl_cmdask() END INPUTEND FUNCTION_set_entry( )，_set_no_entry( )本段應瞭解重點_set_entry( ) 使用 cl_set_comp_entry(.,TRUE) 將欄位開啟_set_no_entry( ) 使用 cl_set_comp_entry

39、(.,FALSE)將欄位關閉程式內容寫法_set_entry( )，_set_no_entry( )FUNCTION i010_set_entry(p_cmd) DEFINE p_cmd VARCHAR(1) IF p_cmd = a AND (NOT g_before_input_done) THEN CALL cl_set_comp_entry(azb01,TRUE) END IFEND FUNCTIONFUNCTION i010_set_no_entry(p_cmd) DEFINE p_cmd VARCHAR(1) IF p_cmd = u AND g_chkey = N THEN CA

40、LL cl_set_comp_entry(azb01,FALSE) END IFEND FUNCTION_a (1)FUNCTION i010_a() MESSAGE CLEAR FORM # 清螢幕欄位內容 INITIALIZE g_azb.* LIKE azb_file.* LET g_azb01_t = NULL LET g_wc = NULL CALL cl_opmsg(a) WHILE TRUE LET = g_user LET = g_grup #使用者所屬群 LET = g_today LET = Y CALL i010_i(a) # 各欄位輸入 IF INT_FLAG THEN

41、 # 假设按了DEL鍵 INITIALIZE g_azb.* TO NULL LET INT_FLAG = 0 CALL cl_err(,9001,0) CLEAR FORM EXIT WHILE END IF_a (2) IF g_azb.azb01 IS NULL THEN # KEY 不可空白 CONTINUE WHILE END IF INSERT INTO azb_file VALUES(g_azb.*) # DISK WRITE IF THEN CALL cl_err(g_azb.azb01,SQLCA.sqlcode,0) CONTINUE WHILE ELSE SELECT R

42、OWID INTO g_azb_rowid FROM azb_file END IF EXIT WHILE END WHILE LET g_wc= END FUNCTION單檔流程圖menuMAINu()q()F/N/P/Lcopy()r()x()out()show()cs()fetch()u()show()show()rep()i()fetch()a()i()show()delh()修改流程本段應瞭解重點確認資料是否可進行修改單頭與單身table修改u()show()i()_u()_u (1)FUNCTION i010_u() IF g_azb.azb01 IS NULL THEN CALL

43、 cl_err(,-400,0) RETURN END IF SELECT * INTO g_azb.* FROM azb_file IF = N THEN CALL cl_err(,9027,0) RETURN END IF MESSAGE CALL cl_opmsg(u) BEGIN WORK_u (2) OPEN i010_cl USING g_azb_rowid IF STATUS THEN CALL cl_err(OPEN i010_cl:, STATUS, 1) CLOSE i010_cl ROLLBACK WORK RETURN END IF FETCH i010_cl INTO

44、 g_azb.* # 對DB鎖定 IF THEN CALL cl_err(g_azb.azb01,SQLCA.sqlcode,1) RETURN END IF LET =g_user #修改者 LET = g_today #修改日期 CALL i010_show() # 顯示最新資料 _u (3) WHILE TRUE CALL i010_i(u) # 欄位更改 IF INT_FLAG THEN LET INT_FLAG = 0 LET g_azb.*=g_azb_t.* CALL i010_show() CALL cl_err(,9001,0) EXIT WHILE END IF UPDAT

45、E azb_file SET azb_file.* = g_azb.* # 更新DB WHERE ROWID = g_azb_rowid IF THEN CALL cl_err(g_azb.azb01,SQLCA.sqlcode,0) CONTINUE WHILE END IF EXIT WHILE END WHILE CLOSE i010_cl COMMIT WORKEND FUNCTION單檔流程圖menuMAINu()q()F/N/P/Lcopy()r()x()out()show()cs()fetch()u()show()show()rep()i()fetch()a()i()show()

46、delh()刪除流程本段應瞭解重點確認資料是否可刪除刪除完畢後將資料指標重新定位，畫面呈現下一筆資料單頭與單身資料刪除r()show()delh()_r()_r (1)FUNCTION i010_r() IF g_azb.azb01 IS NULL THEN CALL cl_err(,-400,0) RETURN END IF BEGIN WORK OPEN i010_cl USING g_azb_rowid IF STATUS THEN CALL cl_err(OPEN i010_cl:, STATUS, 0) CLOSE i010_cl ROLLBACK WORK RETURN END I

47、F FETCH i010_cl INTO g_azb.* IF THEN CALL cl_err(g_azb.azb01,SQLCA.sqlcode,0) RETURN END IF CALL i010_show()_r (2) IF cl_delete() THEN DELETE FROM azb_file CLEAR FORM OPEN i010_count FETCH i010_count INTO g_row_count DISPLAY g_row_count TO OPEN i010_cs IF g_curs_index = g_row_count + 1 THEN LET g_ju

48、mp = g_row_count CALL i010_fetch(L) ELSE LET g_jump = g_curs_index LET g_no_ask = TRUE CALL i010_fetch(/) END IF END IF CLOSE i010_cl COMMIT WORKEND FUNCTION單檔流程圖menuMAINu()q()F/N/P/Lcopy()r()x()out()show()cs()fetch()u()show()show()rep()i()fetch()a()i()show()delh()_copy() 拷貝本段應瞭解重點確認資料是否可被拷貝欄位控制func

49、tion在INPUT前呼叫拷貝程式內容_copy (1)FUNCTION i010_copy() DEFINE l_newno LIKE azb_file.azb01, l_oldno LIKE azb_file.azb01, p_cmd VARCHAR(1), l_input VARCHAR(1) IF g_azb.azb01 IS NULL THEN CALL cl_err(,-400,0) RETURN END IF LET l_input=N LET g_before_input_done = FALSE CALL i010_set_entry(a) LET g_before_inpu

50、t_done = TRUE_copy (2) INPUT l_newno FROM azb01 AFTER FIELD azb01 IF l_newno IS NOT NULL THEN SELECT count(*) INTO g_cnt FROM azb_file WHERE azb01 = l_newno IF g_cnt 0 THEN CALL cl_err(l_newno,-239,0) NEXT FIELD azb01 END IF SELECT gen01 FROM gen_file WHERE gen01= l_newno IF THEN LET l_newno = NULL

51、NEXT FIELD azb01 END IF END IF_copy (3) ON ACTION controlp# 沿用所有欄位 IF INFIELD(azb01) THEN CALL cl_init_qry_var() LET = q_gen CALL cl_create_qry() RETURNING l_newno DISPLAY BY NAME l_newno SELECT gen01 FROM gen_file WHERE gen01= l_newno IF THEN LET l_newno = NULL NEXT FIELD azb01 END IF NEXT FIELD az

52、b01 END IF ON IDLE g_idle_seconds CALL cl_on_idle() CONTINUE INPUT_copy (4) ON ACTION about #MOD-4C0121 CALL cl_about() #MOD-4C0121 ON ACTION help #MOD-4C0121 CALL cl_show_help() #MOD-4C0121 ON ACTION controlg #MOD-4C0121 CALL cl_cmdask() #MOD-4C0121 END INPUT IF INT_FLAG THEN LET INT_FLAG = 0 RETUR

53、N END IF_copy (5) DROP TABLE x SELECT * FROM azb_file WHERE ROWID=g_azb_rowid INTO TEMP x UPDATE x SET azb01=l_newno, #資料鍵值 azbacti=Y, #資料有效碼 azbuser=g_user, #資料所有者 azbgrup=g_grup, #資料所有者所屬群 azbmodu=NULL, #資料修改日期 azbdate=g_today #資料建立日期 INSERT INTO azb_file SELECT * FROM x IF THEN CALL cl_err(g_azb.

54、azb01,SQLCA.sqlcode,0) ELSE MESSAGE ROW(,l_newno,) O.K LET l_oldno LET g_azb.azb01 = l_newno SELECT ROWID,azb_file.* INTO g_azb_rowid,g_azb.* FROM azb_file WHERE azb01 = l_newno CALL i010_u()_copy (6) SELECT ROWID,azb_file.* INTO g_azb_rowid,g_azb.* FROM azb_file WHERE azb01 = l_oldno END IF LET g_a

55、zb.azb01 = l_oldno CALL i010_show()END FUNCTION單檔流程圖menuMAINu()q()F/N/P/Lcopy()r()x()out()show()cs()fetch()u()show()show()rep()i()fetch()a()i()show()delh()其他有效無效碼切換 _x( )報表列印 _out( ) 及報表格式設定之 REPORT function_x (1)FUNCTION i010_x() IF g_azb.azb01 IS NULL THEN CALL cl_err(,-400,0) RETURN END IF BEGIN

56、WORK OPEN i010_cl USING g_azb_rowid IF STATUS THEN CALL cl_err(OPEN i010_cl:, STATUS, 1) CLOSE i010_cl ROLLBACK WORK RETURN END IF FETCH i010_cl INTO g_azb.* IF THEN CALL cl_err(g_azb.azb01,SQLCA.sqlcode,1) RETURN END IF CALL i010_show()_x (2) IF cl_exp(0,0,g_azb.azbacti) THEN LET g_chr= IF =Y THEN

57、LET =N ELSE LET =Y END IF UPDATE azb_file SET azbacti= WHERE ROWID=g_azb_rowid IF SQLCA.SQLERRD3=0 THEN CALL cl_err(g_azb.azb01,SQLCA.sqlcode,0) LET =g_chr END IF DISPLAY BY NAME END IF CLOSE i010_cl COMMIT WORKEND FUNCTION_out (1)FUNCTION i010_out() DEFINE l_i SMALLINT, l_azb RECORD LIKE azb_file.*, l_gen RECORD LIKE gen_file.*, l_name VARCHAR(20), # External(Disk) file name sr RECORD azb01 LIKE azb_file.azb01, azb02 LIKE azb_file.azb02, azb06 LIKE azb_file.azb06, gen02 LIKE gen_file.gen02, gen03 LIKE gen_file.gen03, gen04 LIKE