home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a084 / 2.ddi / CKSAMPLE / SAMPLE.PRG < prev    next >
Encoding:
Text File  |  1993-04-07  |  3.9 KB  |  211 lines
  1.  
  2. PRIVATE ALL
  3. set procedure to sample
  4.  
  5. oldTalk = SET("TALK")
  6. SET TALK OFF
  7. oldCompat = SET("COMPATIBLE")
  8. SET COMPATIBLE OFF
  9. oldArea = SELECT()
  10.  
  11. SET LIBRARY TO fpSQL ADDITIVE
  12.  
  13. DIMENSION TableList[1]
  14. DIMENSION FromList[1]
  15. DIMENSION ColumnList[1]
  16. DIMENSION SelectList[1]
  17. DIMENSION WhereList[1]
  18.  
  19. mess_str = ""
  20.  
  21. ckHandle  = 0
  22. sqlSelect = ""
  23.  
  24. DO Sample.MPR
  25. DO Connect.SPR
  26.  
  27. IF ckHandle = 0
  28.     RELEASE LIBRARY fpSQL
  29.     SET SYSMENU TO DEFAULT
  30.     return
  31. ENDIF
  32.  
  33. exitApp  = .F.
  34. READ CYCLE VALID exitApp
  35.  
  36. SELECT (oldArea)
  37. SET COMPATIBLE &oldCompat
  38. SET TALK &oldTalk
  39.  
  40.  
  41. FUNCTION BuildSQL
  42. PRIVATE lenList, SQLSelect
  43.  
  44.     SQLSelect = "SELECT "
  45.     lenList = ALEN(SelectList) - 1
  46.     IF (lenList != 0)
  47.         SQLSelect = SQLSelect + SelectList[1]
  48.         FOR i = 2 TO lenList
  49.             SQLSelect = SQLSelect + ", " + SelectList[i] + CHR(13)
  50.         ENDFOR
  51.     ENDIF
  52.         
  53.     SQLSelect = SQLSelect + " FROM "
  54.     lenList = ALEN(FromList) - 1
  55.     IF (lenList != 0)
  56.         SQLSelect = SQLSelect + FromList[1]
  57.         FOR i = 2 TO lenList
  58.             SQLSelect = SQLSelect + ", " + FromList[i] + CHR(13)
  59.         ENDFOR
  60.     ENDIF
  61.  
  62.     lenList = ALEN(WhereList) - 1
  63.     IF (lenList != 0)
  64.         SQLSelect = SQLSelect + " WHERE " + WhereList[1]
  65.         FOR i = 2 TO lenList
  66.             SQLSelect = SQLSelect + " " + WhereList[i] + CHR(13)
  67.         ENDFOR
  68.     ENDIF
  69.  
  70. RETURN SQLSelect
  71.  
  72.  
  73. PROCEDURE xQuery
  74. PARAMETER stmt, xMode
  75. PRIVATE retCode, Async
  76.  
  77.     DEFINE WINDOW results ;
  78.         AT  0.000, 0.000  ;
  79.         SIZE 19.000,77.000 ;
  80.         TITLE "Results" ;
  81.         FONT "MS Sans Serif", 8 ;
  82.         STYLE "B" ;
  83.         FLOAT ;
  84.         CLOSE ;
  85.         SHADOW ;
  86.         MINIMIZE ;
  87.         ZOOM GROW ;
  88.         SYSTEM
  89.     MOVE WINDOW results CENTER
  90.  
  91.     IF (ckHandle == 0)
  92.         ?? CHR(7)
  93.         WAIT WINDOW "No server connection"
  94.     ELSE
  95.         SELE 0
  96.         IF (xMode == 2) && Asynch
  97.              retCode = DBSetOpt(ckHandle, "Async", 1)
  98.             IF (retCode < 0)
  99.                 DO RepoErro.SPR WITH retCode
  100.             ENDIF
  101.  
  102.             retCode = 0
  103.             DO WHILE (retCode == 0)
  104.                 retCode = DBExec(ckHandle, stmt)
  105.                 WAIT WINDOW "Query executing" TIMEOUT 1
  106.             ENDDO
  107.  
  108.             IF (retCode < 0)
  109.                 DO RepoErro.SPR WITH retCode
  110.             ELSE
  111.                 GO TOP
  112.                 BROW WINDOW Results
  113.             ENDIF
  114.  
  115.              retCode = DBSetOpt(ckHandle, "Async", 0)
  116.             IF (retCode < 0)
  117.                 DO RepoErro.SPR WITH retCode
  118.             ENDIF
  119.         ELSE && synchronous
  120.             retCode = DBExec(ckHandle, stmt)
  121.             IF (retCode < 0)
  122.                 DO RepoErro.SPR WITH retCode
  123.             ELSE
  124.                 GO TOP
  125.                 BROW WINDOW Results
  126.             ENDIF
  127.         ENDIF
  128.            USE
  129.     ENDIF
  130. RETURN
  131.  
  132.  
  133. PROCEDURE DisConn
  134. PRIVATE retCode
  135.  
  136.     retCode = DBDisConn(ckHandle)
  137.     IF (retCode < 0)
  138.         DO RepoErro.SPR WITH retCode
  139.     ENDIF
  140.     ckHandle  = 0
  141.     DIMENSION TableList[1]
  142.     DIMENSION FromList[1]
  143.     DIMENSION ColumnList[1]
  144.     DIMENSION SelectList[1]
  145.     DIMENSION WhereList[1]
  146.     SHOW MENU _MSYSMENU
  147.     mess_str = "Data Source: none"
  148.     set message to mess_str
  149.  
  150. RETURN
  151.  
  152.  
  153. PROCEDURE BuildTList
  154. PRIVATE nTables, nObjects, retCode
  155.     IF (ckHandle == 0)
  156.         USE Tables
  157.     ELSE
  158.         retCode = DBTables(ckHandle)
  159.         GO TOP
  160.         IF (retCode < 0)
  161.             DO RepoErro.SPR WITH retCode
  162.             DIMENSION TableList[1]
  163.         ENDIF
  164.     ENDIF
  165.     nTables  = 0
  166.     nObjects = RECCOUNT()
  167.     IF (nObjects != 0)
  168.         DIMENSION TableList[nObjects]
  169.         SCAN FOR INLIST(Table_Type, "TABLE", "VIEW")
  170.             nTables = nTables + 1
  171.             TableList[nTables] = ALLTRIM(Table_Name)
  172.         ENDSCAN
  173.     ENDIF
  174.      USE
  175.     DIMENSION TableList[nTables + 1]
  176. RETURN
  177.  
  178. function Yes_No
  179. *-- This function simply allows the user to 
  180. *-- answer yes or no to a prompt. The answer
  181. *-- is then passed back as a logical.
  182.  
  183. parameter cMessage, cMsgHead
  184.  
  185. m.choice = 1
  186. do yesno.spr with cMsgHead,cMessage
  187. return iif(m.choice = 1,.t.,.f.)
  188.   
  189.  
  190. procedure sendcanc
  191.  
  192. if yes_no("Are you sure you wish to send a Cancel message","Send Cancel")
  193.     retCode = DBCancel(ckHandle)
  194.     IF (retCode < 0)
  195.         DO RepoErro.SPR WITH retCode
  196.     ENDIF
  197. endif
  198.  
  199. return
  200.  
  201. procedure showtab
  202.  
  203. retCode = DBTables(ckHandle)
  204. IF (retCode < 0)
  205.     DO RepoErro.SPR WITH retCode
  206.     return
  207. ENDIF
  208.  
  209. browse title "Current Tables"
  210. use
  211. return