4gl读取图纸

一、在项目阶段、经常会有这样的需求，在ERP能直接打开PLM/PDM的图纸。直接上源码。
主要运用的知识点：
PDM/PLM上需要安装ftp的服务器。这里针对FTP的安装文件就不做介绍了。PDM上传附件，文件路径地址传入到后台数据表中作为记录。ERP端利用FTP下载文件，即可打开PDM图纸。

DATABASE ds 
GLOBALS "../../../tiptop/config/top.global"
DEFINE tm RECORD 
     tihao LIKE type_file.chr100,
     wc     string 
     END RECORD 
DEFINE g_aaa DYNAMIC ARRAY OF RECORD 
                itemno   LIKE type_file.chr1000,
                ddno     LIKE type_file.chr1000,
                shibh    LIKE type_file.chr1000,
                guige    LIKE type_file.chr1000,
                fbtuhao  LIKE type_file.chr1000,
                fbname   LIKE type_file.chr1000,
                mdpath   LIKE type_file.chr1000
               END RECORD,
        g_wc,g_wc1   string,  
        g_wc2        string,  
        g_sql        string,  
        l_ac         LIKE type_file.num5,    
        g_argv1      LIKE type_file.chr1000,      
        g_rec_b LIKE type_file.num5           
DEFINE g_itemno,g_ddno,g_shibh,g_guige,g_fbtuhao,g_fbname LIKE type_file.chr1000 
DEFINE   g_cnt          LIKE type_file.num10   
DEFINE   g_msg          LIKE type_file.chr1000 
DEFINE   g_row_count    LIKE type_file.num10   
DEFINE   g_curs_index   LIKE type_file.num10  
DEFINE   g_jump         LIKE type_file.num10   
DEFINE   mi_no_ask      LIKE type_file.num5    
DEFINE g_tihao LIKE type_file.chr100
DEFINE l_ac1 LIKE type_file.num5
 
MAIN
   DEFINE p_row,p_col   LIKE type_file.num5    
    OPTIONS
        INPUT NO WRAP
    DEFER INTERRUPT 
   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
    
    LET tm.wc = ARG_VAL(1) 
    LET tm.wc = cl_replace_str(tm.wc,'\\\"','"')
    LET tm.tihao = ARG_VAL(2) 
    LET tm.tihao = cl_replace_str(tm.tihao,'\\\"','"')
    
    CALL  cl_used(g_prog,g_time,1) RETURNING g_time  
    LET p_row = 4 LET p_col = 2
    OPEN WINDOW q000_w AT p_row,p_col
         WITH FORM "csf/42f/csfq000"
       ATTRIBUTE (STYLE = g_win_style CLIPPED)  
 
    CALL cl_ui_init()
    
    IF NOT cl_null(tm.wc) THEN 
        CALL q000_fill()
    END IF 
        
    CALL q000_menu()
    CLOSE WINDOW q000_w
    CALL  cl_used(g_prog,g_time,2) RETURNING g_time  
END MAIN
 
FUNCTION q000_menu()
   DEFINE   l_cmd     LIKE type_file.chr1000  
   DEFINE   l_apa00   LIKE apa_file.apa00
   DEFINE   l_prog    LIKE zz_file.zz01 
 
   WHILE TRUE
      CALL q000_bp("G")
      CASE g_action_choice
         WHEN "help"
            CALL cl_show_help()
         WHEN "exit"
            EXIT WHILE
         WHEN "controlg"
            CALL cl_cmdask()
         WHEN "query"
            CALL q000_q()
            CALL q000_fill()
            
         WHEN "exporttoexcel"
             IF cl_chk_act_auth() THEN
                CALL cl_export_to_excel
                (ui.Interface.getRootNode(),base.TypeInfo.create(g_aaa),'','')
             END IF
      END CASE
   END WHILE
END FUNCTION
 
FUNCTION q000_fill()  
    DEFINE p_chr LIKE type_file.chr1
    DEFINE p_ima01,l_ima01 LIKE ima_file.ima01                   
    DEFINE l_sql,l_sqll STRING
    DEFINE l_bmb01 LIKE bmb_file.bmb01 
    
    IF NOT cl_null(tm.tihao) THEN 
   
   LET l_sqll="SELECT S_ITEMNO FROM MLDT_0.BOM@MLPDM START WITH F_ITEMNO IN ",
             " (SELECT MD$NUMBER FROM MLDT_0.SHENGCBOM$VF@MLPDM WHERE CCBH LIKE '%",tm.tihao,"%') CONNECT BY PRIOR S_ITEMNO = F_ITEMNO"
    
   CALL g_aaa.clear()
   LET g_cnt = 1
 
       LET l_sql = " select * from MLDT_0.FB_DRAFT@MLPDM where itemno IN (",l_sqll,")"
        
        PREPARE prep_aaa FROM l_sql
        DECLARE decl_aaa CURSOR FOR prep_aaa

       FOREACH decl_aaa INTO g_aaa[g_cnt].*           #單身 ARRAY 填充
     
          LET g_cnt = g_cnt + 1
    
       END FOREACH

    ELSE 
       LET l_sql = " select itemno ,ddno,shibh,guige,fbtuhao,fbname,mdpath from  MLDT_0.FB_DRAFT@MLPDM where ",tm.wc
                  
            PREPARE prep_aaa1 FROM l_sql
            DECLARE decl_aaa1 CURSOR FOR prep_aaa1

            CALL g_aaa.clear()
            LET g_cnt = 1
         
        FOREACH decl_aaa1 INTO g_aaa[g_cnt].*           
            IF SQLCA.sqlcode THEN
                CALL cl_err('foreach:',SQLCA.sqlcode,1)
                EXIT FOREACH
            END IF
      
            LET g_cnt = g_cnt + 1

        END FOREACH
    END IF 
            
    CALL g_aaa.deleteElement(g_cnt)     
    LET g_rec_b = g_cnt -1
    DISPLAY g_rec_b TO FORMONLY.cn2
    CALL SET_COUNT(g_cnt-1)               

END FUNCTION
 
FUNCTION q000_bp(p_ud)
   DEFINE   p_ud   LIKE type_file.chr1    
   DEFINE l_url,l_string STRING
   
   IF p_ud <> "G" THEN
      RETURN
   END IF
 
   CALL SET_COUNT(g_rec_b)
   LET g_action_choice = " "
   CALL cl_set_act_visible("accept,cancel", FALSE)

   DISPLAY ARRAY g_aaa TO s_aaa.* ATTRIBUTE(COUNT=g_rec_b,UNBUFFERED)
      BEFORE DISPLAY
         CALL cl_navigator_setting( g_curs_index, g_row_count )

   ON ACTION ACCEPT
        LET l_ac1 = ARR_CURR()
        IF l_ac1 > 0  THEN
            LET l_url = "ftp://admin:admin@192.168.2.23:2121" CLIPPED,g_aaa[l_ac1].mdpath CLIPPED
            LET l_string = cl_open_url(l_url)
        END IF  

      CALL cl_show_fld_cont()

   ON ACTION EXIT
      LET g_action_choice="exit"
      EXIT DISPLAY

   ON ACTION query
      LET g_action_choice="query"
      EXIT DISPLAY
      
   ON ACTION controlg
      LET g_action_choice="controlg"
      EXIT DISPLAY

   ON ACTION CANCEL
      LET INT_FLAG=FALSE
      LET g_action_choice="exit"
      EXIT DISPLAY

   ON IDLE g_idle_seconds
      CALL cl_on_idle()
      CONTINUE DISPLAY

   END DISPLAY 
   CALL cl_set_act_visible("accept,cancel", TRUE)
END FUNCTION
   
FUNCTION q000_q()   
            LET g_itemno =''
            LET g_ddno   =''
            LET g_shibh  =''
            LET g_guige  =''
            LET g_fbtuhao=''
            LET g_fbname =''
            LET tm.tihao=''
            LET tm.wc=''
            
   DIALOG ATTRIBUTE(unbuffered)
      INPUT BY NAME tm.tihao ATTRIBUTE(WITHOUT DEFAULTS)      
      AFTER FIELD tihao 
         IF NOT cl_null(tm.tihao) THEN 
            LET g_itemno =''
            LET g_ddno   =''
            LET g_shibh  =''
            LET g_guige  =''
            LET g_fbtuhao=''
            LET g_fbname =''
            DISPLAY g_itemno TO itemno 
            DISPLAY g_ddno   TO ddno   
            DISPLAY g_shibh  TO shibh  
            DISPLAY g_guige  TO guige  
            DISPLAY g_fbtuhao TO fbtuhao
            DISPLAY g_fbname TO fbname 
         END IF     
       END INPUT

   CONSTRUCT BY NAME tm.wc ON itemno ,ddno,shibh  ,guige  ,fbtuhao,fbname 

       BEFORE CONSTRUCT
          CALL cl_qbe_init()    
          
      AFTER CONSTRUCT
          IF tm.wc='1=1' OR cl_null(tm.wc) THEN 
          ELSE 
              LET tm.tihao=''
              DISPLAY BY NAME tm.tihao
          END IF 
             
    END CONSTRUCT
                    
      ON ACTION locale
         CALL cl_show_fld_cont()
         LET g_action_choice = "locale"
         EXIT DIALOG

      ON ACTION CONTROLR
         CALL cl_show_req_fields()

      ON ACTION CONTROLG
         CALL cl_cmdask()

      ON IDLE g_idle_seconds
         CALL cl_on_idle()
         CONTINUE DIALOG

      ON ACTION about
         CALL cl_about()

      ON ACTION help
         CALL cl_show_help()

      ON ACTION exit
         LET INT_FLAG = 1
         EXIT DIALOG

      ON ACTION accept
          IF tm.wc='1=1' OR cl_null(tm.wc) THEN 
          ELSE 
              LET tm.tihao=''
              DISPLAY BY NAME tm.tihao
          END IF       
         EXIT DIALOG
      ON ACTION cancel
         LET INT_FLAG=1
         EXIT DIALOG
    END DIALOG
    
END FUNCTION    

核心函数cl_open_url的源码

DATABASE ds        #FUN-6C0017   
GLOBALS "../../config/top.global"   
##########################################################################   
# Descriptions...: Start browser to access an URL   
# Memo...........:    
# Input parameter: ps_url     STRING - URL location   
# Return code....: TRUE/FALSE        - Success/Fail   
# Usage..........: CALL cl_open_url("http://www.kimo.com.tw")   
# Date & Author..: 2004/06/24 by Brendan   
# Modify.........:    
##########################################################################   
FUNCTION cl_open_url(ps_url)  
  DEFINE ps_url       STRING  
  DEFINE ls_browser   STRING  
     
  WHENEVER ERROR CALL cl_err_msg_log  
   
  #No.TQC-830002   
  IF cl_null(ps_url) THEN                                  
     RETURN FALSE  
  END IF  
  #END No.TQC-830002   
   
# LET ls_browser = "C:/Program Files/Internet Explorer/IEXPLORE.EXE"   
# LET ls_browser = "explorer.exe"                       #No.TQC-7B0061   
  #No.TQC-830002   
  IF ps_url.getindexof("ftp://",1) = 1 OR ps_url.getindexof("FTP://",1) = 1 THEN #FUN-A70081   
     LET ls_browser = NULL                                                       #FUN-A70081   
  ELSE                                                                           #FUN-A70081   
     LET ls_browser = cl_client_env("ComSpec")             
     LET ls_browser = "\"", ls_browser, "\" /c explorer"  
  END IF  #FUN-A70081   
  #END No.TQC-830002   
  IF cl_execClientApp(ls_browser, ps_url) THEN  
     RETURN TRUE  
  ELSE   
     RETURN FALSE  
  END IF  
END FUNCTION  
   
##########################################################################   
# Descriptions...: Open a documentation with associated application   
# Memo...........:    
# Input parameter: ps_doc STRING - Documentation location   
# Return code....: TRUE/FALSE  - Success/Error   
# Usage..........: CALL cl_open_doc("C:/tiptop/tiptop.txt")   
# Date & Author..: 2004/06/24 by Brendan   
# Modify.........:    
##########################################################################   
FUNCTION cl_open_doc(ps_doc)  
  DEFINE ps_doc   STRING  
   
   
  IF cl_execClientApp("", ps_doc) THEN  
     RETURN TRUE  
  ELSE   
     RETURN FALSE  
  END IF  
END FUNCTION  
   
##########################################################################   
# Descriptions...: Start an application following by argument   
# Memo...........:    
# Input parameter: ps_prog STRING - Application location   
#                  ps_arg  STRING - Executation argument   
# Return code....: TRUE/FALSE     - Success/Error   
# Usage..........: CALL cl_open_prog("C:/Editor.exe", "C:/tiptop/tiptop.txt")   
# Date & Author..: 2004/06/24 by Brendan   
# Modify.........:    
##########################################################################   
FUNCTION cl_open_prog(ps_prog, ps_arg)  
  DEFINE ps_prog   STRING,  
         ps_arg    STRING     
  #No.TQC-830002   
  IF cl_null(ps_arg) THEN                                  
     RETURN FALSE  
  END IF  
  #END No.TQC-830002   
   
  #-----------------------------------------------------------------------------   
  # ps_arg 多參數時以 | 作為分隔, e.x. ps_arg = "arg1|arg2|arg3 ......"   
  #-----------------------------------------------------------------------------   
  IF cl_execClientApp(ps_prog, ps_arg) THEN  
     RETURN TRUE  
  ELSE   
     RETURN FALSE  
  END IF  
END FUNCTION  
   
##########################################################################   
# Descriptions...: Get an environment variable set in the user session on the front end workstation   
# Memo...........:    
# Input parameter: ps_env    STRING   - Environment variable   
# Return code....: ls_value  STRING   - Value of environment variable   
# Usage..........: CALL cl_client_env("PATH")   
# Date & Author..: 2004/07/16 by Brendan   
# Modify.........:    
##########################################################################   
FUNCTION cl_client_env(ps_env)  
  DEFINE ps_env     STRING  
  DEFINE ls_value   STRING  
    
  IF cl_null(ps_env) THEN  
     RETURN NULL  
  END IF  
   
  CALL ui.Interface.frontCall("standard",  
                              "getenv",  
                              [ps_env],  
                              [ls_value])  
                                 
  IF ( STATUS ) OR ( cl_null(ls_value) ) THEN  
     RETURN NULL  
  ELSE  
     RETURN ls_value  
  END IF  
END FUNCTION  
   
##########################################################################   
# Descriptions...: 指定開啟的程式   
# Memo...........:   
# Input parameter: ps_app  STRING  開啟程式   
#                : ps_doc  STRING  指令,檔案或URL   
# Return code....: TRUE/FALSE      Success/Fail   
# Usage..........: CALL cl_execClientApp(ls_browser,ls_url)   
# Date & Author..: 2004/07/16 by Brendan   
# Modify.........:    
##########################################################################   
FUNCTION cl_execClientApp(ps_app, ps_doc)  
   DEFINE ps_app       STRING,  
          ps_doc       STRING  
   DEFINE li_status    LIKE type_file.num10    #No.FUN-690005  INTEGER   
   DEFINE ls_command   STRING  
   DEFINE lt_tok       base.StringTokenizer,   #No.FUN-760043   
          ls_arg       STRING                  #No.FUN-760043   
   
   IF cl_null(ps_app) AND cl_null(ps_doc) THEN  
      RETURN FALSE  
   END IF  
   
   #----------------------------------------------------------------------------   
   # 若沒有指定程式, 則預設以 shellexec 方式執行指定文件(依照 Windows Registry)   
   #----------------------------------------------------------------------------   
   IF cl_null(ps_app) THEN  
      CALL ui.Interface.frontCall("standard",  
                                  "shellexec",  
                                  [ps_doc],  
                                  [li_status])  
   ELSE  
      #-------------------------------------------------------------------------   
      # 指定執行程式與參數, 多參數需以 | 作為分隔 (暫不使用 No.TQC-830002)   
      #-------------------------------------------------------------------------   
      #LET ls_command = "\"", ps_app, "\""   
      LET ls_command = ps_app                       #No.TQC-830002   
   
      IF NOT cl_null(ps_doc) THEN  
         #-- No.FUN-760043 BEGIN -----------------------------------------------   
         LET lt_tok = base.StringTokenizer.create(ps_doc, "|")  
         WHILE lt_tok.hasMoreTokens()  
             LET ls_arg = lt_tok.nextToken()  
             LET ls_command = ls_command, " \"", ls_arg, "\""  
         END WHILE  
#         LET ls_command = ls_command, " \"", ps_doc, "\""   
         #-- No.FUN-760043 END -------------------------------------------------   
      END IF  
#     CALL ui.Interface.frontCall("standard",    
#                                 "execute",   
#                                 [ls_command, 0],   
#                                 [li_status])   
   
      CALL ui.Interface.frontCall("standard",   
                                  "shellexec",  
                                  [ls_command],  
                                  [li_status])  
   END IF  
   
   IF ( STATUS ) OR ( NOT li_status ) THEN  
      RETURN FALSE  
   END IF  
   
   RETURN TRUE  
END FUNCTION