home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a108 / 13.ddi / DDEDATA.PR_ / DDEDATA.bin
Encoding:
Text File  |  1994-03-10  |  5.5 KB  |  276 lines
  1. *********************************************************************
  2. *
  3. *       DDEData - Simple FoxPro DDE server
  4. *
  5. *********************************************************************
  6.  
  7. #DEFINE   SVR_NAME    "DDEData"
  8.  
  9. PUBLIC ARRAY aiCh(100)
  10.  
  11. = DDESetService(SVR_NAME, "define")
  12. = DDESetService(SVR_NAME, "request", .T.)
  13. = DDESetService(SVR_NAME, "poke", .T.)
  14. = DDESetService(SVR_NAME, "execute", .T.)
  15. = DDESetService(SVR_NAME, "advise", .F.)
  16.  
  17. = DDESetTopic(SVR_NAME, "", "cbDataTopic")
  18.  
  19. RETURN
  20.  
  21.  
  22. *************************************************************
  23. * cbDataTopic - call back for Table, Query or SQL topics
  24. *
  25. * Valid Topics:
  26. *        <database>;TABLE <table name>
  27. *
  28. * Any other topic will cause the INITIATE to fail
  29. *
  30. * Valid Items:
  31. *        All - all data, including field names
  32. *        Data - all data, without field names
  33. *        FieldNames - a list of field names
  34. *        NextRow - the next row of data
  35. *        PrevRow - the previous row
  36. *        FirstRow - the first row of data
  37. *        Last row - the last row of data
  38. *        FieldCount - the number of fields in the table
  39. *        nn - row number to return
  40. *        mm-nn range of rows to return
  41. *
  42. * A Poke request expects the field name as the Item, and
  43. * the new data for that field.  No other Pokes are executed.
  44. *
  45. *************************************************************
  46.  
  47. PROCEDURE cbDataTopic
  48.  
  49. PARAMETERS iChannel, sAction, sItem, sData, sFormat, iStatus
  50. PRIVATE  bResult, sDatabase, sRowType, sRowSrc, iTemp, sUpItem, sUpData
  51. PRIVATE  sResult, iTemp2, bEnabState
  52. PRIVATE sTagTable, sTagSQL, sCRLF, sTAB
  53.  
  54. = DDEEnabled(.F.)                    && we don't want interruptions
  55.  
  56. sTagTable    = ";TABLE"                && must be uppercase
  57.  
  58. bResult = .T.
  59.  
  60. DO CASE
  61.     
  62. CASE sAction = "INITIATE"
  63.     sUpData = UPPER(sData)
  64.     IF ! sTagTable $ sUpData
  65.         bResult = .F.
  66.     ELSE
  67.         iTemp = AT(sTagTable, sUpData)
  68.         sDatabase = LTRIM(SUBSTR(sUpData, 1, iTemp-1))
  69.         SET DEFAULT TO (sDatabase)
  70.         
  71.         sRowSrc = ALLTRIM(SUBSTR(sData, iTemp + LEN(sTagTable)))
  72.         IF NOT (FILE(sRowSrc) OR FILE(sRowSrc+".dbf"))
  73.             bResult = .F.
  74.         ELSE
  75.             * Keep track of work areas used by separate DDE channels.
  76.             iTemp = ASCAN(aiCh, .F.)
  77.             IF iTemp = 0
  78.                 bResult = .F.
  79.             ELSE
  80.                 aiCh[iTemp] = iChannel
  81.                 USE (sRowSrc) IN (iTemp) AGAIN
  82.             ENDIF
  83.         ENDIF
  84.     ENDIF
  85.     
  86. CASE sAction = "REQUEST"
  87.     * Select work area for this DDE channel.
  88.     iTemp = ASCAN(aiCh, iChannel)
  89.     IF iTemp <> 0
  90.         SELECT (iTemp)
  91.     ENDIF
  92.     
  93.     sUpItem = UPPER(sItem)
  94.     DO CASE
  95.     CASE sUpItem = "FIELDNAMES"
  96.         sResult = sFldNames()
  97.         
  98.     CASE sUpItem = "FIELDCOUNT"
  99.         sResult = sFldCount()
  100.         
  101.     CASE sUpItem = "FIRSTROW"
  102.         GOTO TOP
  103.         sResult = sRowData()
  104.         
  105.     CASE sUpItem = "LASTROW"
  106.         GOTO BOTTOM
  107.         sResult = sRowData()
  108.         
  109.     CASE sUpItem = "NEXTROW"
  110.         IF EOF()
  111.             bResult = .F.
  112.         ELSE
  113.             SKIP
  114.             sResult = sRowData()
  115.         ENDIF
  116.         
  117.     CASE sUpItem = "PREVROW"
  118.         IF BOF()
  119.             bResult = .F.
  120.         ELSE
  121.             SKIP -1
  122.             sResult = sRowData()
  123.         ENDIF
  124.         
  125.     CASE sUpItem = "ALL"
  126.         sResult = sFldNames() + sAllData()
  127.         
  128.     CASE sUpItem = "DATA"
  129.         sResult = sAllData()
  130.         
  131.     CASE VAL(sUpItem) <> 0
  132.         iFirst = MAX(1, MIN(INT(VAL(sUpItem)), RECCOUNT()))
  133.         IF "-" $ sUpItem
  134.             iLast = VAL(SUBSTR(sUpItem, AT("-", sUpItem)+1))
  135.             iLast = MAX(1, MIN(iLast, RECCOUNT()))
  136.             iLast = MAX(iFirst, iLast)
  137.             sResult = ""
  138.             GOTO iFirst
  139.             FOR iTemp = iFirst TO iLast
  140.                 sResult = sResult + sRowData()
  141.                 SKIP
  142.             ENDFOR
  143.         ELSE
  144.             GOTO iFirst
  145.             sResult = sRowData()
  146.         ENDIF
  147.         
  148.     OTHERWISE
  149.         bResult = .F.
  150.     ENDCASE
  151.     
  152.     * Send the requested data to the other application.
  153.     
  154.     IF bResult
  155.         = DDEPoke(iChannel, sItem, sResult)
  156.     ENDIF
  157.     
  158. CASE sAction = "POKE"
  159.     FOR iTemp = 1 TO FCOUNT()
  160.         IF FIELD(iTemp) = UPPER(sItem)
  161.             iTemp = 0
  162.             REPLACE &sItem WITH vCvtField(TYPE('&sItem'), sData)
  163.             EXIT
  164.         ENDIF
  165.     ENDFOR
  166.     IF iTemp <> 0
  167.         bResult = .F.
  168.     ENDIF
  169.     
  170. CASE sAction = "TERMINATE"
  171.     iTemp = ASCAN(aiCh, iChannel)
  172.     IF iTemp <> 0
  173.         SELECT (iTemp)
  174.         USE
  175.         aiCh[iTemp] = .F.
  176.     ENDIF
  177.     
  178. OTHERWISE
  179.     bResult = .F.
  180. ENDCASE
  181.  
  182. = DDEEnabled(.T.)
  183.  
  184. RETURN bResult
  185.  
  186.  
  187. ***********************************************************************
  188. *
  189. *  Utility functions
  190. *
  191. ***********************************************************************
  192.  
  193. #DEFINE        sCRLF    CHR(13) + CHR(10)
  194. #DEFINE        sTAB    CHR(9)
  195.  
  196.  
  197. FUNCTION sFldNames
  198. PRIVATE sResult, iTemp
  199.  
  200. sResult = ""
  201. FOR iTemp = 1 TO FCOUNT()
  202.     sResult = sResult + FIELD(iTemp) + sTAB
  203. ENDFOR
  204. sResult = SUBSTR(sResult, 1, LEN(sResult)-1) + sCRLF
  205.  
  206. RETURN sResult
  207.  
  208.  
  209. FUNCTION sFldCount
  210. PRIVATE sResult
  211.  
  212. sResult = STR(FCOUNT())+sCRLF
  213.  
  214. RETURN sResult
  215.  
  216.  
  217. FUNCTION sRowData
  218. PRIVATE sResult, iTemp, avData
  219.  
  220. SCATTER MEMO TO avData
  221.  
  222. sResult = ""
  223. FOR iTemp = 1 TO FCOUNT()
  224.     sResult = sResult + sCvtField(TYPE('avData[iTemp]'), avData[iTemp]) + sTAB
  225. ENDFOR
  226. sResult = SUBSTR(sResult, 1, LEN(sResult)-1) + sCRLF
  227.  
  228. RETURN sResult
  229.  
  230.  
  231. FUNCTION sAllData
  232. PRIVATE sResult
  233.  
  234. sResult = ""
  235. SCAN
  236.     sResult = sResult + sRowData()
  237. ENDSCAN
  238.  
  239. RETURN sResult
  240.  
  241.  
  242. FUNCTION sCvtField
  243. PARAMETERS sType, vValue
  244. PRIVATE    sTemp
  245.  
  246. DO CASE
  247. CASE INLIST(sType, 'C', 'M')
  248.     sTemp = vValue
  249. CASE INLIST(sType, 'N', 'F')
  250.     sTemp = ALLTRIM(STR(vValue,15))
  251. CASE sType = 'D'
  252.     sTemp = DTOC(vValue)
  253. CASE sType = 'L'
  254.     sTemp = IIF(vValue, 'YES', 'NO')
  255. ENDCASE
  256.  
  257. RETURN sTemp
  258.  
  259.  
  260. FUNCTION vCvtField
  261. PARAMETERS sType, sValue
  262. PRIVATE vTemp
  263.  
  264. DO CASE
  265. CASE INLIST(sType, 'C', 'M')
  266.     vTemp = sValue
  267. CASE INLIST(sType, 'N', 'F')
  268.     vTemp = VAL(sValue)
  269. CASE sType = 'D'
  270.     vTemp = CTOD(sValue)
  271. CASE sType = 'L'
  272.     vTemp = IIF(UPPER(ALLTRIM(sValue)) $ 'YES', .T., .F.)
  273. ENDCASE
  274.  
  275. RETURN vTemp
  276.