首先是一个基本的 CURD 程式

DATABASE [email protected]

GLOBALS
DEFINE rec RECORD LIKE student.*
DEFINE student_count SMALLINT
DEFINE gr_student RECORD LIKE student.*
END GLOBALS

MAIN 
  DEFER INTERRUPT
  CALL open_window()
  CALL student_menu()
  CALL close_window()
END MAIN

FUNCTION dummy()
     ERROR "該功能未完成"
END FUNCTION

FUNCTION student_menu()
   #CLEAR SCREEN 
   #CALL open_window()

       MENU "學生信息管理系統"
           BEFORE MENU
             HIDE OPTION ALL
             SHOW OPTION "Query","Add","Exit"
       COMMAND "Query" "查詢資料"
          IF query_student() = TRUE THEN
            SHOW OPTION "Next","Previous","Update","Delete"
          ELSE
            HIDE OPTION ALL
            SHOW OPTION "Query","Add","Exit"
          END IF
        # CALL query_student()
       COMMAND "Next" "顯示下一筆"
           CALL fetch_student(1)
        COMMAND "Previous" "顯示上一筆"
           CALL fetch_student(-1)
         COMMAND "Add" "新增一筆資料"
           CALL input_student()
         COMMAND "Update" "修改一筆資料"
           CALL update_student()
         COMMAND "Delete" "刪除一筆資料"
           CALL delete_student()
         COMMAND "Exit" "結束"
           EXIT MENU
      END MENU

END FUNCTION

FUNCTION input_student()

    CLEAR FORM
    LET INT_FLAG = FALSE
    LET rec.stu_id=' '
    LET rec.stu_name=' '
    LET rec.stu_city= ' '
    #CALL open_window()
      MESSAGE "輸入各值.[Esc] 執行[Ctl-C] 放棄" 

    INPUT BY NAME rec.* WITHOUT DEFAULTS 

   #驗證輸入是否空,顯示錯誤
    AFTER FIELD stu_id
    IF rec.stu_id = ' ' or rec.stu_id is NULL THEN
    error "ID不能為空!"
    NEXT FIELD stu_id
    END IF  

    AFTER FIELD stu_name
    IF rec.stu_name = ' ' or rec.stu_name is NULL THEN
    error "Name不能為空!"
    NEXT FIELD stu_name
    END IF

    AFTER FIELD stu_city
    IF rec.stu_city = ' ' or rec.stu_city is NULL THEN
    error "City不能為空!"
    NEXT FIELD stu_city
    END IF

  END INPUT

  IF data_bad() THEN
        MESSAGE "該資料已存在,請重新輸入"
                      SLEEP 2
  ELSE
    CLEAR FORM
       #中斷處理 
       IF INT_FLAG = TRUE THEN
        LET INT_FLAG = FALSE
        ERROR "中斷!"
        RETURN
       END IF
    INSERT INTO student VALUES (rec.*) 
    IF STATUS = 0 THEN
        MESSAGE "新增資料成功"
        SLEEP 2 #時間延時
    END IF
  END IF 

END FUNCTION

FUNCTION data_bad()
       LET student_count=0
         SELECT COUNT(*) INTO student_count FROM student
           WHERE student.stu_id=rec.stu_id
      IF student_count=1 THEN
        RETURN TRUE
     ELSE 
        RETURN FALSE
     END IF
END FUNCTION

{FUNCTION query_student()
    CLEAR FORM
    LET INT_FLAG = FALSE
    LET rec.stu_id=' '
    LET rec.stu_name=' '
    LET rec.stu_city= ' '

    PROMPT "輸入要查詢的學生ID: " FOR rec.stu_id
    IF data_bad() THEN
           SELECT * INTO rec.* FROM student
               WHERE student.stu_id = rec.stu_id
               MESSAGE "Name:",rec.stu_name,"City:",rec.stu_city
               SLEEP 10
     ELSE
        MESSAGE "沒有查到指定的記錄"
        SLEEP 2
     END IF

END FUNCTION}

#以下query_student()使用第9章的方法
FUNCTION query_student()
    #QBE合併查詢
    DEFINE where_clause CHAR(250)
    DEFINE sql_qry CHAR(300)

    MESSAGE "請輸入查詢條件,然後按ESC"

    LET INT_FLAG = FALSE
    CONSTRUCT BY NAME where_clause ON student.*
    IF INT_FLAG = TRUE THEN  #當按下Ctrl-C時
        LET INT_FLAG = FALSE 
        ERROR "操作中斷!"
                RETURN FALSE 
    END IF
    #情況1:挑選符合條件的資料
    LET sql_qry = "SELECT * FROM student where ",where_clause CLIPPED
    #MESSAGE sql_qry  #TEST sql_qry
    #SLEEP 20
    PREPARE ex_stmt1 FROM sql_qry #PREPARE後的變量不需要DEFINE

    DECLARE student_ptr SCROLL CURSOR FOR ex_stmt1#此命令將經由SQL中SELECT敘述所取得的RECORDSET與一個CURSOR相鏈接,鎖住(LOCK)
      {
      DECALRE cursor_name CURSOR [ WITH HOLD ] FOR SELECT_statement FOR UPDATE
      }
         OPEN student_ptr
         FETCH FIRST student_ptr INTO gr_student.* #取出一筆資料記錄將其放入變量中

               IF SQLCA.SQLCODE = NOTFOUND THEN
                ERROR "找不到任何記錄"
                CALL clean_up()
                 RETURN FALSE #加了之後報錯
               ELSE 
                CALL display_student()
                RETURN TRUE
               END IF
END FUNCTION

{
FUNCTION next_student()
    FETCH NEXT student_ptr INTO gr_student.*
    IF SQLCA.SQLCODE = NOTFOUND THEN
        ERROR "已經到了底部"
    ELSE 
        CALL display_student()
    END IF
END FUNCTION
}

{
FUNCTION prior_student()
    FETCH PRIOR student_ptr INTO gr_student.*
    IF SQLCA.SQLCODE = NOTFOUND THEN
        ERROR "已經到了頂部"
    ELSE
        CALL display_student()
    END IF
END FUNCTION
}

FUNCTION fetch_student(fetch_flag)
   DEFINE fetch_flag SMALLINT
   FETCH RELATIVE fetch_flag student_ptr INTO gr_student.* 
   IF SQLCA.SQLCODE = NOTFOUND THEN 
    IF fetch_flag = 1 THEN
        ERROR "已經到了底部"
    ELSE
        ERROR "已經到了頂部"
    END IF
   ELSE
    CALL display_student()
   END IF

END FUNCTION

FUNCTION update_student()
      LET INT_FLAG = FALSE

      message "輸入各值.[Esc] 執行[Ctl-C] 放棄"
      INPUT BY NAME gr_student.* WITHOUT DEFAULTS

      IF INT_FLAG = TRUE THEN
        LET INT_FLAG = FALSE 
        ERROR "操作中斷"
        RETURN
      END IF

      UPDATE student 
             SET (stu_name,stu_city)
               =(gr_student.stu_name,gr_student.stu_city)
               WHERE student.stu_id = gr_student.stu_id

       MESSAGE "操作更新成功"
       SLEEP 2      

END FUNCTION

{
FUNCTION updel_init()
   DECLARE lockstudent CURSOR FOR 
    SELECT * FROM student
        WHERE student.stu_id = gr_student.stu_id
     FOR UPDATE
END FUNCTION
}

FUNCTION delete_student()
      #CALL updel_init() #DECLARE 一個LOCKING CURSOR
      #OPEN lockstudent
      #FETCH lockstudent INTO gr_student.*

      MENU "你真的要刪除這條記錄嗎?"
          COMMAND "NO" "不要刪除這條記錄"
             ERROR "刪除中斷" ATTRIBUTE (BLINK,BOLD)
          COMMAND "YES" "確定刪除這條記錄"
             DELETE FROM student 
                 WHERE student.stu_id = gr_student.stu_id
                  AND student.stu_name = gr_student.stu_name
                  AND student.stu_city = gr_student.stu_city
              MESSAGE "Student ID: ",gr_student.stu_id,"已經被刪除"
              SLEEP 2
           EXIT MENU
        END MENU    
END FUNCTION

FUNCTION open_window()
   OPEN WINDOW w_student_form AT 2,2 
    WITH FORM "student"
     ATTRIBUTE (FORM LINE FIRST + 1, BORDER ) #加顏色或是一些特效   
END FUNCTION 

FUNCTION close_window()
    CLOSE WINDOW w_student_form
END FUNCTION

FUNCTION options_init()
  OPTIONS
  ERROR LINE LAST-2
 END FUNCTION

 FUNCTION display_student()
          DISPLAY BY NAME gr_student.*
 END FUNCTION

 FUNCTION clean_up()
      WHENEVER ERROR CONTINUE
        CLOSE student_ptr
        FREE student_ptr
       WHENEVER ERROR STOP
  END FUNCTION

未完待续。

--再怎么看都没有啦|´・ω・)ノ--