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