home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a084 / 2.ddi / CKSAMPLE / MAINPROG.PRG < prev    next >
Encoding:
Text File  |  1993-05-25  |  5.6 KB  |  277 lines
  1. * main program for the FoxPro Connectivity Kit Sample Application
  2. * Microsoft Corp. (c) 1993
  3.  
  4. PRIVATE ALL
  5. SET PROCEDURE TO mainprog
  6.  
  7. * save settings
  8. IF  SET("TALK") = "ON"
  9.     SET TALK OFF
  10.     oldtalk = "ON"
  11. ELSE
  12.     oldtalk = "OFF"
  13. ENDIF
  14. oldcompat = SET("COMPATIBLE")
  15. SET COMPATIBLE OFF
  16. oldarea = SELECT()
  17. oldsafe = SET("SAFETY")
  18. SET SAFETY OFF
  19.  
  20. ON KEY LABEL ALT+F4 
  21. ON KEY LABEL ALT+F4 
  22.  
  23. * use the library with all of the connectivity functions
  24. DO CASE
  25.     CASE _DOS
  26.         SET LIBRARY TO LOCFILE("fpsql.plb","PLB","Where is fpsql?") ADDITIVE
  27.     CASE _WINDOWS
  28.         SET LIBRARY TO LOCFILE("fpsql.fll","FLL","Where is fpsql?") ADDITIVE
  29. ENDCASE
  30.  
  31. * set up global arrays for query builder
  32. DIMENSION tablelist[1]
  33. DIMENSION fromlist[1]
  34. DIMENSION columnlist[1]
  35. DIMENSION selectlist[1]
  36. DIMENSION wherelist[1]
  37.  
  38. * Global Variables
  39. mess_str = ""
  40. m.asynch = 0
  41. ckhandle  = 0
  42. sqlselect = ""
  43.  
  44. * determine which work areas are currently in use
  45. badnews = .f.
  46. on error badnews = .t.
  47. areacnt = 1
  48. do while ((not badnews) and (areacnt <= 225))
  49.     DIMENSION used_array(areacnt)
  50.     used_array(areacnt) = used(areacnt)
  51.     areacnt = areacnt + 1
  52. enddo
  53. closem = .t.
  54. on error
  55.  
  56. PUSH MENU _MSYSMENU
  57. * put up main menu
  58. DO sample.mpr
  59.  
  60. * attempt to make an initial connection
  61. DO connect.spr
  62.  
  63. * if the connection was not successful, punt
  64. IF ckhandle = 0
  65.     RELEASE LIBRARY fpsql
  66.     SET SYSMENU TO DEFAULT
  67.     RETURN
  68. ENDIF
  69.  
  70. * foundation read
  71. exitapp  = .F.
  72. READ CYCLE VALID exitapp
  73.  
  74. * close tables if desired
  75. if closem
  76.     for i = 1 to alen(used_array)
  77.         if not used_array(i)
  78.             if used(i)
  79.                 select i
  80.                 use
  81.             endif
  82.         endif
  83.     endfor
  84. endif
  85.  
  86. * reset environment
  87. SELECT (oldarea)
  88. SET COMPATIBLE &oldcompat
  89. SET SAFETY &oldsafe
  90. SET TALK &oldtalk
  91. POP MENU _MSYSMENU
  92.  
  93. * end of mainprog
  94.  
  95.  
  96. * build SQL statement from the selections made in build query
  97. FUNCTION buildsql
  98. PRIVATE lenlist, sqlselect
  99.  
  100. sqlselect = "SELECT "
  101. lenlist = ALEN(selectlist) - 1
  102.  
  103. * if there was at least one field selected, select 'em
  104. * otherwise select '*'
  105. IF (lenlist > 0)
  106.     sqlselect = sqlselect + selectlist[1]
  107.     FOR i = 2 TO lenlist
  108.         sqlselect = sqlselect + ", " + selectlist[i] + CHR(13)
  109.     ENDFOR
  110. ELSE
  111.     sqlselect = sqlselect + "*"
  112. ENDIF
  113.  
  114. * if there was at least table selected, use 'em
  115. * otherwise select return null (no statement possible)
  116. lenlist = ALEN(fromlist) - 1
  117. IF (lenlist > 0)
  118.     sqlselect = sqlselect + " FROM "
  119.     sqlselect = sqlselect + fromlist[1]
  120.     FOR i = 2 TO lenlist
  121.         sqlselect = sqlselect + ", " + fromlist[i] + CHR(13)
  122.     ENDFOR
  123. ELSE
  124.     RETURN ""
  125. ENDIF
  126.  
  127. * if there was at least one where statement entered, use 'em
  128. lenlist = ALEN(wherelist) - 1
  129. IF (lenlist > 0)
  130.     sqlselect = sqlselect + " WHERE " + wherelist[1]
  131.     FOR i = 2 TO lenlist
  132.         sqlselect = sqlselect + " " + wherelist[i] + CHR(13)
  133.     ENDFOR
  134. ENDIF
  135.  
  136. RETURN sqlselect
  137.  
  138.  
  139. * execute the query passed in the parameter
  140. PROCEDURE xquery
  141. PARAMETER stmt
  142. PRIVATE retcode
  143.  
  144. * nothing to do
  145. IF EMPTY(stmt)
  146.     WAIT WINDOW "No query to execute!" NOWAIT
  147.     RETURN
  148. ENDIF
  149.  
  150. * define a window to put the results in
  151. DEFINE WINDOW results ;
  152.     AT  0.000, 0.000  ;
  153.     SIZE 19.000,77.000 ;
  154.     TITLE "Results" ;
  155.     FONT "MS Sans Serif", 8 ;
  156.     STYLE "B" ;
  157.     FLOAT ;
  158.     CLOSE ;
  159.     SHADOW ;
  160.     MINIMIZE ;
  161.     ZOOM GROW ;
  162.     COLOR SCHEME 10 ;
  163.     SYSTEM
  164. MOVE WINDOW results CENTER
  165.  
  166. IF (ckhandle == 0)
  167.     * this sould not happen
  168.     ?? CHR(7)
  169.     WAIT WINDOW "No server connection"
  170.     RETURN
  171. ELSE
  172.     SELE 0
  173.     wait window "Executing query..." nowait
  174.     * in asynchronous mode, wait for the results
  175.     IF (m.asynch == 1) && Asynch
  176.         retcode = 0
  177.         DO WHILE (retcode == 0)
  178.             retcode = dbexec(ckhandle, stmt)
  179.             WAIT WINDOW "Query executing" TIMEOUT 1
  180.         ENDDO
  181.         
  182.         * if an error is returned, display  it
  183.         * otherwise display results.
  184.         IF (retcode < 0)
  185.             DO repoerro.spr WITH retcode
  186.         ELSE
  187.             IF USED()
  188.                 GO TOP
  189.                 BROW WINDOW results
  190.             ELSE
  191.                 WAIT WINDOW "Done!" NOWAIT
  192.             ENDIF
  193.         ENDIF
  194.     ELSE && Synchronous
  195.         * in asynchronous mode, no need to wait for the results
  196.         retcode = dbexec(ckhandle, stmt)
  197.         IF (retcode < 0)
  198.             DO repoerro.spr WITH retcode
  199.         ELSE
  200.             IF USED()
  201.                 GO TOP
  202.                 BROW WINDOW results
  203.             ELSE
  204.                 WAIT WINDOW "Done!" NOWAIT
  205.             ENDIF
  206.         ENDIF
  207.     ENDIF
  208. ENDIF
  209. RETURN
  210.  
  211. * disconnect from current data share
  212. PROCEDURE disconn
  213. PRIVATE retcode
  214.  
  215. retcode = dbdisconn(ckhandle)
  216. IF (retcode < 0)
  217.     DO repoerro.spr WITH retcode
  218. ENDIF
  219. * clear global variables
  220. ckhandle  = 0
  221. DIMENSION tablelist[1]
  222. DIMENSION fromlist[1]
  223. DIMENSION columnlist[1]
  224. DIMENSION selectlist[1]
  225. DIMENSION wherelist[1]
  226. SHOW MENU _msysmenu
  227. WAIT WINDOW "Disconnected From "+mess_str NOWAIT
  228. mess_str = "Data Source: none"
  229. SET MESSAGE TO mess_str
  230.  
  231. RETURN
  232.  
  233.  
  234. * build a list of tables for the current database
  235. PROCEDURE buildtlist
  236. PRIVATE ntables, nobjects, retcode
  237. IF (ckhandle == 0)
  238.     USE tables
  239. ELSE
  240.     IF (m.asynch == 1) && Asynch
  241.         retcode = 0
  242.         DO WHILE (retcode == 0)
  243.             retcode = dbtables(ckhandle)
  244.         ENDDO
  245.     ELSE
  246.         retcode = dbtables(ckhandle)
  247.     ENDIF
  248.     IF (retcode < 0)
  249.         DO repoerro.spr WITH retcode
  250.         DIMENSION tablelist[1]
  251.         return
  252.     ENDIF
  253. ENDIF
  254. ntables  = 0
  255. nobjects = RECCOUNT()
  256. IF (nobjects != 0)
  257.     DIMENSION tablelist[nObjects]
  258.     SCAN FOR INLIST(table_type, "TABLE", "VIEW","U","V")
  259.         ntables = ntables + 1
  260.         tablelist[nTables] = ALLTRIM(table_name)
  261.     ENDSCAN
  262. ENDIF
  263. USE
  264. DIMENSION tablelist[nTables + 1]
  265. RETURN
  266.  
  267. FUNCTION yes_no
  268. * This function simply allows the user to
  269. * answer yes or no to a prompt. The answer
  270. * is then passed back as a logical.
  271.  
  272. PARAMETER cmessage, cmsghead
  273.  
  274. m.choice = 1
  275. DO yesno.spr WITH cmsghead,cmessage
  276. RETURN IIF(m.choice = 1,.T.,.F.)
  277.