home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a040 / 2.ddi / SHRWARE4.ARC / MSADRIV.INC < prev    next >
Encoding:
Text File  |  1988-06-03  |  6.2 KB  |  321 lines
  1. <<* MSADRIV.INC *>>
  2.  
  3. <<#
  4. procedure GenSelect
  5. begin
  6.   if dbfals
  7.     genln( 'SELECT ',dbfals )
  8.   elsif dbfcount = 0
  9.     genln( 'SELECT A' )
  10.   else
  11.     genln( 'SELECT ',chr( 64 + dbfcount ) )  <<*'A'..'J'*>>
  12.   endif
  13. end GenSelect
  14. #>>
  15.  
  16.  
  17. <<procedure GenFormat>>
  18. <<begin>>
  19.  
  20. PROCEDURE {fileprefix}_FORM
  21.   <<pushmargin( 1 )>>
  22.   <<GenFormHead>>
  23.   <<GenFormBody>>
  24.   <<popmargin>>
  25. RETURN
  26.  
  27. <<end GenFormat>>
  28.  
  29.  
  30. <<#
  31. procedure GenSaysBlock( IsWithMems : logical )
  32. begin
  33.   if IsWithMems
  34.     GenMemInit
  35.     GenMemCalc
  36.   endif
  37.   GenSaysBody
  38. end GenSaysBlock
  39.  
  40.  
  41. procedure GenStoreBlock
  42. begin
  43.   genln( '* ---Initialize memvars with field contents.' )
  44.   select on databases,fields
  45.   select all fields
  46.   forall (fldtyp $ 'CDLN') and (fldals <> 'M') and fldget
  47.     genln( 'STORE ',ljust( fldnam,10 ),' TO ',fixfldnam )
  48.   endfor
  49. end GenStoreBlock
  50.  
  51.  
  52. procedure GenReplaceBlock
  53. begin
  54.   genln( 'IF .NOT. EOF()' )
  55.   genln( '* ---Replace only if there is an available record.' )
  56.   select on databases,fields
  57.   select all fields
  58.   select fields on (fldtyp $ 'CDLN') and (fldals <> 'M') and fldget
  59.   if fldtotal > 0
  60.     GenReplaceFlds
  61.   endif
  62.   select all fields
  63.   genln( 'ENDIF' )
  64. end GenReplaceBlock
  65.  
  66.  
  67. procedure GenGetsBlock( IsWithMems : logical )
  68. begin
  69.   if IsWithMems
  70.     GenMemInit
  71.     select database 1
  72.     GenGetsBody
  73.     GenCalcBody
  74.   else
  75.     GenGetsBody
  76.   endif
  77. end GenGetsBlock
  78.  
  79.  
  80. procedure GenOneSays( ptype : integer; alias,filename : string )
  81. string fspec
  82. begin
  83.   if (ptype = 1) or (ptype = 2)
  84. #>>
  85.  
  86.     <<if ptype = 1>>
  87. PROCEDURE {fileprefix}_SAYS
  88.     <<else>>
  89. PROCEDURE {fileprefix}_{alias}SAY
  90.     <<endif>>
  91.    * ---Using {filename}
  92.   <<pushmargin( 1 )>>
  93.   <<GenSaysBlock( ptype=1 )>>
  94.   <<popmargin>>
  95. RETURN
  96.  
  97. <<#
  98.   elsif ptype = 3
  99.     fspec := prgpath + fileprefix + '_' + alias + 'SAY.PRG'
  100.     if OpenFile( fspec,'@/SAY commands for ' + filename )
  101.       GenSaysBlock( false )
  102.       GenFooter( fspec )
  103.     endif
  104.   endif
  105. end GenOneSays
  106.  
  107.  
  108. procedure GenOneStore( ptype : integer; alias,filename : string )
  109. string fspec
  110. begin
  111.   if (ptype = 1) or (ptype = 2)
  112. #>>
  113.  
  114.     <<if ptype = 1>>
  115. PROCEDURE {fileprefix}_STOR
  116.     <<else>>
  117. PROCEDURE {fileprefix}_{alias}STO
  118.     <<endif>>
  119.    * ---Using {filename}
  120.   <<pushmargin( 1 )>>
  121.   <<GenStoreBlock>>
  122.   <<popmargin>>
  123. RETURN
  124.  
  125. <<#
  126.   elsif ptype = 3
  127.     fspec := prgpath + fileprefix + '_' + alias + 'STO.PRG'
  128.     if OpenFile( fspec,'STORE commands for ' + filename )
  129.       GenStoreBlock
  130.       GenFooter( fspec )
  131.     endif
  132.   endif
  133. end GenOneStore
  134.  
  135.  
  136. procedure GenOneReplace( ptype : integer; alias,filename : string )
  137. string fspec
  138. begin
  139.   if (ptype = 1) or (ptype = 2)
  140. #>>
  141.  
  142.     <<if ptype = 1>>
  143. PROCEDURE {fileprefix}_REPL
  144.     <<else>>
  145. PROCEDURE {fileprefix}_{alias}REP
  146.     <<endif>>
  147.    * ---Using {filename}
  148.   <<pushmargin( 1 )>>
  149.   <<GenReplaceBlock>>
  150.   <<popmargin>>
  151. RETURN
  152.  
  153. <<#
  154.   elsif ptype = 3
  155.     fspec := prgpath + fileprefix + '_' + alias + 'REP.PRG'
  156.     if OpenFile( fspec,'REPLACE commands for ' + filename )
  157.       GenReplaceBlock
  158.       GenFooter( fspec )
  159.     endif
  160.   endif
  161. end GenOneReplace
  162.  
  163.  
  164. procedure GenOneGets( ptype : integer; alias,filename : string )
  165. string fspec
  166. begin
  167.   if (ptype = 1) or (ptype = 2)
  168. #>>
  169.  
  170.     <<if ptype = 1>>
  171. PROCEDURE {fileprefix}_GETS
  172.     <<else>>
  173. PROCEDURE {fileprefix}_{alias}GET
  174.     <<endif>>
  175.    * ---Using {filename}
  176.   <<pushmargin( 1 )>>
  177.   <<GenGetsBlock( ptype=1 )>>
  178.   <<popmargin>>
  179. RETURN
  180.  
  181. <<#
  182.   elsif ptype = 3
  183.     fspec := prgpath + fileprefix + '_' + alias + 'GET.PRG'
  184.     if OpenFile( fspec,'@/GET commands for ' + filename )
  185.       GenGetsBlock( false )
  186.       GenFooter( fspec )
  187.     endif
  188.   endif
  189. end GenOneGets
  190.  
  191.  
  192. procedure GenDriver
  193. string alias
  194. begin
  195. #>>
  196.  
  197. PROCEDURE {fileprefix}_SAYS
  198. <<#
  199.   pushmargin(1)
  200.   GenMemInit
  201.   GenMemCalc
  202.   popmargin
  203.   forall databases
  204.     alias := chr( dbfcount + 64 )
  205.     pushmargin( 1 )
  206.     GenSelect
  207.     popmargin
  208. #>>
  209.    DO {fileprefix}_{alias}SAY
  210.   <<endfor>>
  211.    SELECT &dbfarea
  212. RETURN
  213.  
  214.  
  215. PROCEDURE {fileprefix}_GETS
  216.    <<pushmargin(1)>>
  217.    <<GenMemInit>>
  218.    <<popmargin>>
  219.    DO CASE
  220. <<forall databases>>
  221.    CASE dbfarea = {"}{dbfcount}{"}
  222. <<#
  223.     alias := chr( dbfcount + 64 )
  224.     pushmargin( 2 )
  225.     GenSelect
  226.     genln( 'DO ',fileprefix,'_',alias,'GET' )
  227.     GenCalcFlds
  228.     popmargin
  229.   endfor
  230. #>>
  231.    ENDCASE
  232.   <<pushmargin(1)>>
  233.   <<GenCalcMems>>
  234.   <<popmargin>>
  235. RETURN
  236.  
  237.  
  238. PROCEDURE {fileprefix}_STOR
  239.    DO CASE
  240. <<forall databases>>
  241.   <<alias := chr( dbfcount + 64 )>>
  242.    CASE dbfarea = {"}{dbfcount}{"}
  243.       DO {fileprefix}_{alias}STO
  244. <<endfor>>
  245.    ENDCASE
  246. RETURN
  247.  
  248.  
  249. PROCEDURE {fileprefix}_REPL
  250.    DO CASE
  251. <<forall databases>>
  252.   <<alias := chr( dbfcount + 64 )>>
  253.    CASE dbfarea = {"}{dbfcount}{"}
  254.       DO {fileprefix}_{alias}REP
  255. <<endfor>>
  256.    ENDCASE
  257. RETURN
  258.  
  259. <<end>> <<*GenDriver*>>
  260.  
  261.  
  262. <<#
  263. procedure GenProcGroups( ptype : integer )
  264. string  filename,alias
  265. integer count
  266. begin
  267.   for count := 1 to 4
  268.     select all
  269.     forall databases
  270.       filespec( dbfnam,fpath,fname,fext )
  271.       filename := fname + '.DBF'
  272.       alias := chr( dbfcount + 64 )
  273.       if count = 1
  274.         GenOneSays( ptype,alias,filename )
  275.       elsif count = 2
  276.         GenOneGets( ptype,alias,filename )
  277.       elsif count = 3
  278.         GenOneStore( ptype,alias,filename )
  279.       elsif count = 4
  280.         GenOneReplace( ptype,alias,filename )
  281.       endif
  282.     endfor
  283.   endfor
  284. end <<*GenProcGroups*>>
  285.  
  286.  
  287. procedure GenProcedures
  288. string fspec,filename
  289. logical IsOK,IsTwoProcs
  290. integer ptype
  291. begin
  292.   filename := datafile + '.DBF'
  293.   fspec := fileprefix + '_PROC.PRG'
  294.   IsOK := OpenFile( prgpath + fspec,'PROCEDURE file for ' + filename )
  295.   if IsOK
  296.     GenProcStandard
  297.   endif
  298.   if IsOK
  299.     GenProcSecond
  300.     GenKeysProc
  301.     GenFormat
  302.     if ismultials
  303.       GenDriver
  304.       ptype := 2   <<*Keep procedures inside one file*>>
  305.       GenProcGroups( ptype )
  306.       if ptype <> 3
  307.         genln( '* EOF: ',fspec  )
  308.       endif
  309.     else
  310.       GenOneSays( 1,'',filename )
  311.       GenOneGets( 1,'',filename )
  312.       GenOneStore( 1,'',filename )
  313.       GenOneReplace( 1,'',filename )
  314.       genln( '* EOF: ',fspec  )
  315.     endif
  316.   endif
  317. end <<*GenProcedures*>>
  318.  
  319. <<* EOF: MSADRIV.INC *>>
  320. #>>
  321.