home *** CD-ROM | disk | FTP | other *** search
/ Shareware 1 2 the Maxx / sw_1.zip / sw_1 / WORD / FP2WP5.ZIP / FP2WP5.PRG next >
Text File  |  1992-03-28  |  2KB  |  135 lines
  1. *
  2. * Procedure:
  3. *   FP2WP5
  4. * Purpose:
  5. *   Create WordPerfect v5.1 secondary merge file from Foxpro database
  6. * Input:
  7. *   - Current database area has the database
  8. *   - File header.wp contains the header from an empty wp document 
  9. *      (since I don't know the format of a WP header)
  10. *     To create header.wp, start wp and save the blank screen.
  11. * Output:
  12. *   Name of the output file is same as database, with extension ".2"
  13. *
  14. procedure FP2WP5
  15. do StartUp with alltrim(alias())+".2"
  16. do OutFieldNames
  17. scan
  18.     do chat
  19.     for m.i = 1 to fcount()
  20.            do OutField with m.i
  21.     endfor
  22.     do EndRecord
  23. endscan
  24. do ShutDown
  25. return
  26.  
  27. *******************************************
  28. *
  29. * Output field names
  30. *
  31. procedure OutFieldNames
  32. do FieldList
  33. for m.i = 1 to fcount()
  34.     ?? field(m.i)+"~"
  35. endfor
  36. ?? "~"
  37. do EndRecord
  38. return
  39. *******************************************
  40. *
  41. * Output one field
  42. *
  43. procedure OutField 
  44. parameter m.i
  45. private m.var, m.out
  46. m.var = eval(FIELD(m.i))
  47. do case 
  48. case type('m.var')='C'
  49.     m.out = m.var
  50. case type('m.var')='N'
  51.     m.out = str(m.var)
  52. case type('m.var')='D'
  53.     m.out = dtoc(m.var)
  54. case type('m.var')='L'
  55.     m.out = iif(m.var,'True','False')
  56. endcase
  57. ?? alltrim(m.out)
  58. do EndField
  59. return
  60.  
  61. *******************************************
  62. *
  63. * Output wp's {FIELD LIST} code
  64. *
  65. procedure FieldList
  66. ?? chr(222)
  67. ?? 'b'
  68. ?? chr(04)+chr(0)
  69. ?? chr(04)+chr(0)
  70. ?? 'b'
  71. ?? chr(222)
  72. return
  73.  
  74. *******************************************
  75. *
  76. * Output wp's {END FIELD} code
  77. *
  78. procedure EndField
  79. ?? chr(222)
  80. ?? 1
  81. ?? chr(04)+chr(0)
  82. ?? chr(04)+chr(0)
  83. ?? 1
  84. ?? chr(222)
  85. ?? chr(10)
  86. return
  87.  
  88. *******************************************
  89. *
  90. * Output wp's {END RECORD} code
  91. *
  92. procedure EndRecord
  93. ?? chr(222)
  94. ?? chr(52)
  95. ?? chr(6)+chr(0)
  96. ?? chr(0)+chr(0)
  97. ?? chr(6)+chr(0)
  98. ?? chr(52)
  99. ?? chr(222)
  100. ?? chr(10)
  101. return
  102.  
  103. *******************************************
  104. *
  105. * Say what we're doing
  106. *
  107. procedure chat
  108. if recno() % 10 = 0
  109.        wait window nowait ltrim(str(recno())) + " of " + ;
  110.            ltrim(str(reccount())) + " records copied."
  111. endif
  112. return
  113.  
  114. *******************************************
  115. *
  116. * Initialize
  117. *
  118. procedure StartUp
  119. parameter outname
  120. set console off
  121. set talk off
  122. copy file header.wp to (outname)
  123. set print to (outname) additive
  124. set print on
  125. return
  126.  
  127. *******************************************
  128. *
  129. * Get ready to quit
  130. *
  131. procedure ShutDown
  132. set print off
  133. set print to
  134. return
  135.