一个CR报表csfr010作业的4gl代码，程序是用在了genero中输出一份出厂测试报告的4gl代码# Prog. Version..: '5.10.08-09.06.11(00009)' #
# Pattern name...: csfr010.4gl
# Descriptions...: test
# Date & Author..: 111223 By
DATABASE ds
GLOBALS "../../../tiptop/config/top.global"
DEFINE tm RECORD
wc STRING, # Where condition
#oeb01 LIKE oeb_file.oeb01,因字段长度不够，改为下边的声明
oeb01 LIKE type_file.chr1000,
type LIKE type_file.chr1,
dat LIKE oga_file.oga02, # Prog. Version..: '5.10.08-09.06.11(01)
more LIKE type_file.chr1000 # Prog. Version..: '5.10.08-09.06.11(01) # Input more condition(Y/N)
END RECORD
DEFINE l_table STRING,
g_str STRING,
g_sql STRING
DEFINE g_type LIKE type_file.chr2 #add by chenyu --100319
MAIN
OPTIONS
FORM LINE FIRST + 2,
MESSAGE LINE LAST,
PROMPT LINE LAST,
INPUT NO WRAP
DEFER INTERRUPT # Supress DEL key function
IF (NOT cl_user()) THEN
EXIT PROGRAM
END IF
WHENEVER ERROR CALL cl_err_msg_log
IF (NOT cl_setup("CSF")) THEN
EXIT PROGRAM
END IF
CALL cl_used(g_prog,g_time,1) RETURNING g_time #No.FUN-690126
## *** 與 Crystal Reports 串聯段 - <<<< 產生Temp Table >>>> ##
LET g_sql = " oeb01.oeb_file.oeb01,",
" oeb03.oeb_file.oeb03,",
" oeb04.oeb_file.oeb04,",
" oeb06.oeb_file.oeb06,",
" num1.oeb_file.oeb12 "
LET l_table = cl_prt_temptable('csfr010',g_sql) CLIPPED # 產生Temp Table
IF l_table = -1 THEN EXIT PROGRAM END IF # Temp Table產生
LET g_sql = "INSERT INTO ds_report.",l_table CLIPPED,
" VALUES(?, ?, ?, ?, ? )"
PREPARE insert_prep FROM g_sql
IF STATUS THEN
CALL cl_err('insert_prep:',status,1) EXIT PROGRAM
END IF
#----------------------------------------------------------CR (1) ------------#
INITIALIZE tm.* TO NULL # Default condition
LET g_pdate = ARG_VAL(1) # Get arguments from command line
LET g_towhom = ARG_VAL(2)
LET g_rlang = ARG_VAL(3)
LET g_bgjob = ARG_VAL(4)
LET g_prtway = ARG_VAL(5)
LET g_copies = ARG_VAL(6)
LET tm.wc = ARG_VAL(7)
LET tm.dat = ARG_VAL(8)
LET g_rep_user = ARG_VAL(9)
LET g_rep_clas = ARG_VAL(10)
LET g_template = ARG_VAL(11)
LET g_rpt_name = ARG_VAL(12)
LET g_type = ARG_VAL(13) #add by chenyu --100322
IF cl_null(g_bgjob) THEN LET g_bgjob = 'N' END IF #add by chenyu --100322
IF cl_null(tm.wc)
THEN CALL csfr010_tm(0,0)
ELSE
CALL csfr010()
END IF
CALL cl_used(g_prog,g_time,2) RETURNING g_time
END MAIN
FUNCTION csfr010_tm(p_row,p_col)
DEFINE lc_qbe_sn LIKE gbm_file.gbm01
DEFINE p_row,p_col LIKE type_file.num5,
l_cmd LIKE type_file.chr1000
LET p_row = 5 LET p_col = 17
OPEN WINDOW csfr010_w AT p_row,p_col WITH FORM "csf/42f/csfr010"
ATTRIBUTE (STYLE = g_win_style CLIPPED)
CALL cl_ui_init()
LET tm.type = '1'
LET tm.dat = g_today
LET g_pdate = g_today
LET g_rlang = g_lang
LET g_bgjob = 'N'
LET g_copies = '1'
CALL cl_opmsg('p')
WHILE TRUE
CONSTRUCT BY NAME tm.oeb01 ON oeb01
#END CONSTRUCT
#INPUT BY NAME tm.oeb01 WITHOUT DEFAULTS
BEFORE CONSTRUCT
CALL cl_qbe_display_condition(lc_qbe_sn)
ON ACTION CONTROLZ
CALL cl_show_req_fields()
ON ACTION CONTROLG
CALL cl_cmdask() # Command execution
ON IDLE g_idle_seconds
CALL cl_on_idle()
CONTINUE CONSTRUCT
ON ACTION about
CALL cl_about()
ON ACTION help
CALL cl_show_help()
ON ACTION exit
LET INT_FLAG = 1
EXIT CONSTRUCT
ON ACTION qbe_save
CALL cl_qbe_save()
ON ACTION controlp
IF INFIELD(oeb01) THEN
CALL cl_init_qry_var()
LET g_qryparam.form = "q_oeb12"
LET g_qryparam.state = "c"
CALL cl_create_qry() RETURNING g_qryparam.multiret
DISPLAY g_qryparam.multiret TO oeb01
NEXT FIELD oeb01
END IF
END CONSTRUCT
IF INT_FLAG THEN
LET INT_FLAG = 0 CLOSE WINDOW csfr010_w
CALL cl_used(g_prog,g_time,2) RETURNING g_time
EXIT PROGRAM
END IF
IF g_bgjob = 'Y' THEN
SELECT zz08 INTO l_cmd FROM zz_file #get exec cmd (fglgo xxxx)
WHERE zz01='csfr010'
IF SQLCA.sqlcode OR l_cmd IS NULL THEN
CALL cl_err('csfr010','9031',1)
ELSE
LET tm.wc=cl_replace_str(tm.wc, "'", "\"")#"
LET l_cmd = l_cmd CLIPPED, #(at time fglgo xxxx p1 p2 p3)
" '",g_pdate CLIPPED,"'",
" '",g_towhom CLIPPED,"'",
" '",g_rlang CLIPPED,"'",
" '",g_bgjob CLIPPED,"'",
" '",g_prtway CLIPPED,"'",
" '",g_copies CLIPPED,"'",
" '",tm.wc CLIPPED,"'" ,
" '",tm.dat CLIPPED,"'" ,
" '",g_rep_user CLIPPED,"'",
" '",g_rep_clas CLIPPED,"'",
" '",g_template CLIPPED,"'",
" '",g_rpt_name CLIPPED,"'"
CALL cl_cmdat('csfr010',g_time,l_cmd) # Execute cmd at later time
END IF
CLOSE WINDOW csfr010_w
CALL cl_used(g_prog,g_time,2) RETURNING g_time
EXIT PROGRAM
END IF
CALL cl_wait()
CALL csfr010()
ERROR ""
END WHILE
CLOSE WINDOW csfr010_w
END FUNCTION
FUNCTION csfr010()
DEFINE l_name LIKE type_file.chr20,
l_sql LIKE type_file.chr1000,
l_exrate LIKE azk_file.azk03,
sr RECORD
oeb01 LIKE oeb_file.oeb01,
oeb03 LIKE oeb_file.oeb03,
oeb04 LIKE oeb_file.oeb04,
oeb06 LIKE oeb_file.oeb06,
num1 LIKE oeb_file.oeb12
END RECORD
DEFINE l_geb01 LIKE geb_file.geb01
DEFINE l_occ01 LIKE occ_file.occ01
DEFINE l_occ02 LIKE occ_file.occ02
DEFINE l_occ33 LIKE occ_file.occ33
DEFINE l_occ63 LIKE occ_file.occ63
DEFINE l_tot2 LIKE occ_file.occ63
DEFINE g_occ63 LIKE occ_file.occ63
DEFINE l_cnt LIKE type_file.num5
LET tm.oeb01=tm.oeb01
## *** 與 Crystal Reports 串聯段 - <<<< 清除暫存資料 >>>>
CALL cl_del_data(l_table)
#------------------------------ CR (2) ------------------------------#
SELECT zo02 INTO g_company FROM zo_file WHERE zo01 = g_rlang
SELECT zz05 INTO g_zz05 FROM zz_file WHERE zz01 = g_prog
# FOR g_i = 1 TO g_len LET g_dash[g_i,g_i] = '=' END FOR
IF g_priv2='4' THEN #只能使用自己的資料
LET tm.wc = tm.wc CLIPPED," AND occuser = '",g_user,"'"
END IF
IF g_priv3='4' THEN #只能使用相同群的資料
LET tm.wc = tm.wc clipped," AND occgrup MATCHES '",g_grup CLIPPED,"*'"
END IF
IF g_priv3 MATCHES "[5678]" THEN #TQC-5C0134群組權限
LET tm.wc = tm.wc clipped," AND occgrup IN ",cl_chk_tgrup_list()
END IF
LET l_sql = "SELECT oeb01,oeb03,oeb04,oeb06,1 ",
" FROM ds01.oeb_file a,(SELECT rownum rn FROM ",
" (SELECT max(oeb12) max_rec FROM ds01.oeb_file ",
" WHERE ",tm.oeb01, # 'SMSXX-2211070130' ",
" ) connect by level <= max_rec) b WHERE a.oeb12>=rn ",
" AND ",tm.oeb01, # 'SMSXX-2211070130' ",
" ORDER BY oeb03 "
PREPARE csfr010_prepare FROM l_sql
IF SQLCA.sqlcode THEN
CALL cl_err('prepare:',SQLCA.sqlcode,1)
CALL cl_used(g_prog,g_time,2) RETURNING g_time
EXIT PROGRAM
END IF
DECLARE csfr010_curs CURSOR FOR csfr010_prepare
FOREACH csfr010_curs INTO sr.*
EXECUTE insert_prep USING sr.*
INITIALIZE sr.* TO NULL
END FOREACH
## **** 與 Crystal Reports 串聯段 - <<<< CALL cs3() >>>> **** ##
LET l_sql = "SELECT * FROM ",g_cr_db_str CLIPPED,l_table CLIPPED
#是否列印選擇條件
IF g_zz05 = 'Y' THEN
CALL cl_wcchp(tm.wc,'geb01')
RETURNING tm.wc
LET g_str = tm.wc
END IF
CALL cl_prt_cs3('csfr010','csfr010',l_sql,g_str)
END FUNCTION
4fd文件
<?xml version="1.0" encoding="UTF-8" ?>
<Form width="54" lstrtoalltitle="false" lstrtoallitem="false" database_name="ds" spacing="normal" CHECKSUM="-1" posX="0" posY="0" height="6" percommentheader="" percommentinstruction="" percommentattribute="" lstrtoallcomment="false" percommentschema="" name="csfr010" fourSTFile="" defaultspacing="true" text="csfr010" percommentlayout="GRID
GRID
GROUP
GRID
VBOX
LAYOUT
" lstrtoalltext="false" gstVersion="11401" browserStatus="true" >
<Grid width="50" posX="3" posY="0" height="4" lstrcomment="false" hidden="--------" name="gr8224" fontPitch="default" scroll="false" >
<Group width="48" lstrtext="false" gridWidth="49" posX="0" posY="0" height="3" lstrcomment="false" hidden="--------" name="group01" fontPitch="default" text="QBE" gridHeight="5" gridChildrenInParent="--------" >
<Text width="5" lstrtext="false" gridWidth="16" posX="1" posY="1" height="1" sizePolicy="initial" name="text27968" text="oeb01" />
<FormField sqlDBName="formonly" colName="oeb01" sqlTabName="formonly" fieldId="0" name="oeb01" fieldtype="FORM_ONLY" >
<ButtonEdit width="20" case="NONE" justify="none" invisible="--------" notNull="--------" posX="23" image="zoom" posY="1" height="1" formfieldname="formfield0" action="controlp" lstrcomment="false" length="10" autoNext="--------" colorCondition="black" verify="--------" imagetype="Image as URL" hidden="--------" tabIndex="1" sizePolicy="initial" reverse="--------" name="oeb01" data_type="VARCHAR" fontPitch="default" color="black" century="R" scroll="--------" required="--------" noEntry="--------" />
</FormField>
</Group>
</Grid>
</Form>