!
!       MAKSRC  Generate ANDI equivalent file i/o statements
!       Copyright 1989, 1990 by Jim-Barry Behar
!       ALL RIGHTS RESERVED
!
       program maksrc,1.0(2)
!
!       Created on 28-Aug-89 at 10:49 AM by Jim-Barry Behar [001]
!       Updated on 31-Jan-90 at  7:18 PM by Jim-Barry Behar [002]
!
!       All commercial rights are reserved.
!       This program is placed in the public domain without any
!       warranties, or guarranties of any kind.
!       Neither the author, nor Florida Datatek, Inc. shall be held
!       responsible for damages resulting from the use of this program.
!       Florida Datatek, Inc. has nothing to do with this program.
!
! Edit History:
!
! [001] Created
! [002] Cleaned up for d/STUFF release
!
! Future enhancements:  Read ".DEF" file and generate code based on contents
!                       Generate "FETCH'KEY" routine using d/BASIC for
!                         right justification, and zero filling etc.
!
!
!
def main'dbs'name="xxxxxx"      ! replace xxxxxx with main file name
!
def max'slots=32                ! replace with maximum number of
                               ! data or key files
!
map1 dbs(max'slots),s,32
map1 key(max'slots),s,32        ! packet name
map1 kyn(max'slots),s,32        ! key file name
map1 kyf(max'slots),s,32        ! data file key is index for
map1 loop,f
!
def num'dbs=                    ! insert number of active dbs files
def num'key=                    ! insert number of active key files
!
!
! dbs() slots hold data file names
! kyn() slots hold key file names
! kyf() slots hold the name of the owner data base that kyn() references
!
!
dbs( 1)="      " : kyn( 1)="      " : kyf( 1)="      "
dbs( 2)="      " : kyn( 2)="      " : kyf( 2)="      "
dbs( 3)="      " : kyn( 3)="      " : kyf( 3)="      "
dbs( 4)="      " : kyn( 4)="      " : kyf( 4)="      "
dbs( 5)="      " : kyn( 5)="      " : kyf( 5)="      "
dbs( 6)="      " : kyn( 6)="      " : kyf( 6)="      "
dbs( 7)="      " : kyn( 7)="      " : kyf( 7)="      "
dbs( 8)="      " : kyn( 8)="      " : kyf( 8)="      "
dbs( 9)="      " : kyn( 9)="      " : kyf( 9)="      "
dbs(10)="      " : kyn(10)="      " : kyf(10)="      "
dbs(11)="      " : kyn(11)="      " : kyf(11)="      "
dbs(12)="      " : kyn(12)="      " : kyf(12)="      "
dbs(13)="      " : kyn(13)="      " : kyf(13)="      "
dbs(14)="      " : kyn(14)="      " : kyf(14)="      "
dbs(15)="      " : kyn(15)="      " : kyf(15)="      "
dbs(16)="      " : kyn(16)="      " : kyf(16)="      "
dbs(17)="      " : kyn(17)="      " : kyf(17)="      "
dbs(18)="      " : kyn(18)="      " : kyf(18)="      "
dbs(19)="      " : kyn(19)="      " : kyf(19)="      "
dbs(20)="      " : kyn(20)="      " : kyf(20)="      "
dbs(21)="      " : kyn(21)="      " : kyf(21)="      "
dbs(22)="      " : kyn(22)="      " : kyf(22)="      "
dbs(23)="      " : kyn(23)="      " : kyf(23)="      "
dbs(24)="      " : kyn(24)="      " : kyf(24)="      "
dbs(25)="      " : kyn(25)="      " : kyf(25)="      "
dbs(26)="      " : kyn(26)="      " : kyf(26)="      "
dbs(27)="      " : kyn(27)="      " : kyf(27)="      "
dbs(28)="      " : kyn(28)="      " : kyf(28)="      "
dbs(29)="      " : kyn(29)="      " : kyf(29)="      "
dbs(30)="      " : kyn(30)="      " : kyf(30)="      "
dbs(31)="      " : kyn(31)="      " : kyf(31)="      "
dbs(32)="      " : kyn(32)="      " : kyf(32)="      "
!
       for loop=1 to num'key
               key(loop)=main'dbs'name+"'KEY'"+str(loop)
       next loop
!
       open #1,main'dbs'name+".fio",output
       print #1,"!"
       print #1,"!!!!! All Key File Manipulation Calls"
       print #1,"!"

       print #1,"!"
       print #1,"!!!!! Retrieve next key from key file KEY'FIL"
       print #1,"!"
       print #1,"NXT'KEY:"

       when num'key>1
               print #1,"      on KEY'FIL goto ";
               for loop=1 to num'key-1
                       print #1,"T"+str(loop)+",";
               next loop
               print #1,"T"+str(num'key)
               print #1,"      W'STR="+chr(34)+"NXT'KEY"+chr(34)+" : goto I'ERR"
               print #1
       wend

       for loop=1 to num'key
               if num'key>1 print #1,"T"+str(loop)+":  "; else print #1,chr(9);
               print #1,"next.key in "+rtrim(key(loop))+" using KEY'STR"
               print #1,"      FLAG(1)="+rtrim(key(loop))+"_FLAG1"
               print #1,"      return"
       next loop

       print #1,"!"
       print #1,"!!!!! Find key KEY'STR in key file KEY'FIL"
       print #1,"!"
       print #1,"FND'KEY:"

       when num'key>1
               print #1,"      on KEY'FIL goto ";
               for loop=1 to num'key-1
                       print #1,"U"+str(loop)+",";
               next loop
               print #1,"U"+str(num'key)
               print #1,"      W'STR="+chr(34)+"FND'KEY"+chr(34)+" : goto I'ERR"
               print #1
       wend

       for loop=1 to num'key
               if num'key>1 print #1,"U"+str(loop)+":  "; else print #1,chr(9);
               print #1,"find.key in "+rtrim(key(loop))+" using KEY'STR"
               print #1,"      FLAG(1)="+rtrim(key(loop))+"_FLAG1"
               print #1,"      return"
       next loop

       print #1,"!"
       print #1,"!!!!! Add key KEY'STR to key file KEY'FIL"
       print #1,"!"
       print #1,"ADD'KEY:"

       when num'key>1
               print #1,"      on KEY'FIL goto ";
               for loop=1 to num'key-1
                       print #1,"V"+str(loop)+",";
               next loop
               print #1,"V"+str(num'key)
               print #1,"      W'STR="+chr(34)+"ADD'KEY"+chr(34)+" : goto I'ERR"
               print #1
       wend

       for loop=1 to num'key
               if num'key>1 print #1,"V"+str(loop)+":  "; else print #1,chr(9);
               print #1,"add.key to "+rtrim(key(loop))+" using KEY'STR";
               print #1," of "+rtrim(kyf(loop))
               print #1,"      FLAG(1)="+rtrim(key(loop))+"_FLAG1"
               print #1,"      return"
       next loop

       print #1,"!"
       print #1,"!!!!! Delete key KEY'STR from key file KEY'FIL"
       print #1,"!"
       print #1,"DEL'KEY:"

       when num'key>1
               print #1,"      on KEY'FIL goto ";
               for loop=1 to num'key-1
                       print #1,"X"+str(loop)+",";
               next loop
               print #1,"X"+str(num'key)
               print #1,"      W'STR="+chr(34)+"DEL'KEY"+chr(34)+" : goto I'ERR"
               print #1
       wend

       for loop=1 to num'key
               if num'key>1 print #1,"X"+str(loop)+":  "; else print #1,chr(9);
               print #1,"delete.key from "+rtrim(key(loop))+" using KEY'STR";
               print #1," of "+rtrim(kyf(loop))
               print #1,"      FLAG(1)="+rtrim(key(loop))+"_FLAG1"
               print #1,"      return"
       next loop

       print #1,"!"
       print #1,"!!!!! Retrieve previouskey from key file KEY'FIL"
       print #1,"!"
       print #1,"PRE'KEY:"

       when num'key>1
               print #1,"      on KEY'FIL goto ";
               for loop=1 to num'key-1
                       print #1,"W"+str(loop)+",";
               next loop
               print #1,"W"+str(num'key)
               print #1,"      W'STR="+chr(34)+"PRE'KEY"+chr(34)+" : goto I'ERR"
               print #1
       wend

       for loop=1 to num'key
               if num'key>1 print #1,"W"+str(loop)+":  "; else print #1,chr(9);
               print #1,"previous.key in "+rtrim(key(loop))+" using KEY'STR"
               print #1,"      FLAG(1)="+rtrim(key(loop))+"_FLAG1"
               print #1,"      return"
       next loop

       print #1,"!"
       print #1,"!!!!! All File Manipulation Calls"
       print #1,"!"
       print #1,"!"
       print #1,"!!!!! Fetch a field for display"
       print #1,"!"
       print #1,"FET'FLD:"
       print #1,"      call RET'FLD"
       print #1,"      if FLAG(4)=3 FIL'STR=str(FIL'FLT)"
       print #1,"      if FLAG(4)=6 FIL'STR=str(FIL'BIN)"
       print #1,"      return"
       print #1,"!"
       print #1,"!!!!! Prepare a field for writing to file"
       print #1,"!"
       print #1,"SET'FLD:"
       print #1,"      call FLD'PAR"
       print #1,"      if FLAG(4)=3 FIL'FLT=val(FIL'STR)"
       print #1,"      if FLAG(4)=6 FIL'BIN=val(FIL'STR)"
       print #1,"      call PUT'FLD"
       print #1,"      return"

       print #1,"!"
       print #1,"!!!!! Read record without locking it"
       print #1,"!"
       print #1,"READ'REC:"
       when num'dbs>1
               print #1,"      on DBS'FIL goto ";
               for loop=1 to num'dbs-1
                       print #1,"J"+str(loop)+",";
               next loop
               print #1,"J"+str(num'dbs)
               print #1,"      W'STR="+chr(34)+"READ'REC"+chr(34)+" : goto I'ERR"
               print #1
       wend

       for loop=1 to num'dbs
               if num'dbs>1 print #1,"J"+str(loop)+":  "; else print #1,chr(9);
               print #1,dbs(loop)+"_RECDNO=RECDNO("+str(loop)+")"
               print #1,"      read.record from "+dbs(loop)
               print #1,"      goto SET'FLAGS"
       next loop

       print #1,"!"
       print #1,"!!!!! Extract record from file"
       print #1,"!"
       print #1,"EXT'REC:"

       when num'dbs>1
               print #1,"      on DBS'FIL goto ";
               for loop=1 to num'dbs-1
                       print #1,"K"+str(loop)+",";
               next loop
               print #1,"K"+str(num'dbs)
               print #1,"      W'STR="+chr(34)+"EXT'REC"+chr(34)+" : goto I'ERR"
               print #1
       wend

       for loop=1 to num'dbs
               if num'dbs>1 print #1,"K"+str(loop)+":  "; else print #1,chr(9);
               print #1,dbs(loop)+"_RECDNO=RECDNO("+str(loop)+")"
               print #1,"      lock.record from "+dbs(loop)
               print #1,"      goto SET'FLAGS"
       next loop

       print #1,"!"
       print #1,"!!!!! Read record only if it's unlocked"
       print #1,"!"
       print #1,"RIU'REC:"

       when num'dbs>1
               print #1,"      on DBS'FIL goto ";
               for loop=1 to num'dbs-1
                       print #1,"L"+str(loop)+",";
               next loop
               print #1,"L"+str(num'dbs)
               print #1,"      W'STR="+chr(34)+"RIU'REC"+chr(34)+" : goto I'ERR"
               print #1
       wend

       for loop=1 to num'dbs
               if num'dbs>1 print #1,"L"+str(loop)+":  "; else print #1,chr(9);
               print #1,dbs(loop)+"_RECDNO=RECDNO("+str(loop)+")"
               print #1,"      read.unlocked from "+dbs(loop)
               print #1,"      goto SET'FLAGS"
       next loop

       print #1,"!"
       print #1,"!!!!! Write record"
       print #1,"!"
       print #1,"WRITE'REC:"

       when num'dbs>1
               print #1,"      on DBS'FIL goto ";
               for loop=1 to num'dbs-1
                       print #1,"M"+str(loop)+",";
               next loop
               print #1,"M"+str(num'dbs)
               print #1,"      W'STR="+chr(34)+"WRITE'REC"+chr(34)+" : goto I'ERR"
               print #1
       wend

       for loop=1 to num'dbs
               if num'dbs>1 print #1,"M"+str(loop)+":  "; else print #1,chr(9);
               print #1,dbs(loop)+"_RECDNO=RECDNO("+str(loop)+")"
               print #1,"      write.record to "+dbs(loop)
               print #1,"      goto SET'FLAGS"
       next loop

       print #1,"!"
       print #1,"!!!!! Add record to file"
       print #1,"!"
       print #1,"ADD'REC:"

       when num'dbs>1
               print #1,"      on DBS'FIL goto ";
               for loop=1 to num'dbs-1
                       print #1,"N"+str(loop)+",";
               next loop
               print #1,"N"+str(num'dbs)
               print #1,"      W'STR="+chr(34)+"ADD'REC"+chr(34)+" : goto I'ERR"
               print #1
       wend

       for loop=1 to num'dbs
               if num'dbs>1 print #1,"N"+str(loop)+":  "; else print #1,chr(9);
               print #1,"add.record to "+dbs(loop)
               print #1,"      RECDNO("+str(loop)+")="+dbs(loop)+"_RECDNO"
               print #1,"      goto SET'FLAGS"
       next loop

       print #1,"!"
       print #1,"!!!!! Delete record from file"
       print #1,"!"
       print #1,"DEL'REC:"

       when num'dbs>1
               print #1,"      on DBS'FIL goto ";
               for loop=1 to num'dbs-1
                       print #1,"O"+str(loop)+",";
               next loop
               print #1,"O"+str(num'dbs)
               print #1,"      W'STR="+chr(34)+"DEL'REC"+chr(34)+" : goto I'ERR"
               print #1
       wend

       for loop=1 to num'dbs
               if num'dbs>1 print #1,"O"+str(loop)+":  "; else print #1,chr(9);
               print #1,dbs(loop)+"_RECDNO=RECDNO("+str(loop)+")"
               print #1,"      delete.record from "+dbs(loop)
               print #1,"      goto SET'FLAGS"
       next loop

       print #1,"!"
       print #1,"!!!!! Release lock on record"
       print #1,"!"
       print #1,"REL'REC:"

       when num'dbs>1
               print #1,"      on DBS'FIL goto ";
               for loop=1 to num'dbs-1
                       print #1,"P"+str(loop)+",";
               next loop
               print #1,"P"+str(num'dbs)
               print #1,"      W'STR="+chr(34)+"REL'REC"+chr(34)+" : goto I'ERR"
               print #1
       wend

       for loop=1 to num'dbs
               if num'dbs>1 print #1,"P"+str(loop)+":  "; else print #1,chr(9);
               print #1,dbs(loop)+"_RECDNO=RECDNO("+str(loop)+")"
               print #1,"      unlock.record of "+dbs(loop)
               print #1,"      goto SET'FLAGS"
       next loop

       print #1,"!"
       print #1,"!!!!! Retrieve field named "+chr(34)+"FLD'STR"+chr(34)
       print #1,"!"
       print #1,"RET'FLD:"

       when num'dbs>1
               print #1,"      on DBS'FIL goto ";
               for loop=1 to num'dbs-1
                       print #1,"Q"+str(loop)+",";
               next loop
               print #1,"Q"+str(num'dbs)
               print #1,"      W'STR="+chr(34)+"RET'FLD"+chr(34)+" : goto I'ERR"
               print #1
       wend

       for loop=1 to num'dbs
               if num'dbs>1 print #1,"Q"+str(loop)+":  "; else print #1,chr(9);
               print #1,"FIL'BIN=0"
               print #1,"      get.field of "+dbs(loop)+" named FLD'STR into FIL'STR"
               print #1,"      if "+dbs(loop)+"_FLAG2=0 goto FLD'NOT'FND"
               print #1,"      goto SET'FLAGS"
       next loop

       print #1,"!"
       print #1,"!!!!! Put field named "+chr(34)+"FLD'STR"+chr(34)+" to record"
       print #1,"!"
       print #1,"PUT'FLD:"

       when num'dbs>1
               print #1,"      on DBS'FIL goto ";
               for loop=1 to num'dbs-1
                       print #1,"R"+str(loop)+",";
               next loop
               print #1,"R"+str(num'dbs)
               print #1,"      W'STR="+chr(34)+"PUT'FLD"+chr(34)+" : goto I'ERR"
               print #1
       wend

       for loop=1 to num'dbs
               if num'dbs>1 print #1,"R"+str(loop)+":  "; else print #1,chr(9);
               print #1,"put.field to "+dbs(loop)+" named FLD'STR from FIL'STR"
               print #1,"      goto SET'FLAGS"
       next loop

       print #1,"!"
       print #1,"!!!!! Retrieve field parameters"
       print #1,"!"
       print #1,"FLD'PAR:"

       when num'dbs>1
               print #1,"      on DBS'FIL goto ";
               for loop=1 to num'dbs-1
                       print #1,"Z"+str(loop)+",";
               next loop
               print #1,"Z"+str(num'dbs)
               print #1,"      W'STR="+chr(34)+"FLD'PAR"+chr(34)+" : goto I'ERR"
               print #1
       wend

       for loop=1 to num'dbs
               if num'dbs>1 print #1,"Z"+str(loop)+":  "; else print #1,chr(9);
               print #1,"field.info in "+dbs(loop)+" about FLD'STR "
               print #1,"      goto SET'FLAGS"
       next loop

       print #1,"!"
       print #1,"!!!!! Set status flags"
       print #1,"!"
       print #1,"SET'FLAGS:"

       when num'dbs>1
               print #1,"      on DBS'FIL goto ";
               for loop=1 to num'dbs-1
                       print #1,"S"+str(loop)+",";
               next loop
               print #1,"S"+str(num'dbs)
               print #1,"      W'STR="+chr(34)+"SET'FLAGS"+chr(34)+" : goto I'ERR"
               print #1
       wend

       for loop=1 to num'dbs
               if num'dbs>1 print #1,"S"+str(loop)+":";
               print #1,"      FLAG(1)="+dbs(loop)+"_FLAG1"
               print #1,"      FLAG(2)="+dbs(loop)+"_FLAG2"
               print #1,"      FLAG(3)="+dbs(loop)+"_FLAG3"
               print #1,"      FLAG(4)="+dbs(loop)+"_FLAG4"
               print #1,"      FLAG(5)="+dbs(loop)+"_FLAG5"
               print #1,"      return"
       next loop
       close #1

       open #2,main'dbs'name+".str",output

       print #2,"structure dbms'packet"
       print #2,"      1 BUFFER"
       print #2,"              2 RECDNO,b,4"
       print #2,"              2 FLAG1,b,4"
       print #2,"              2 FLAG2,b,4"
       print #2,"              2 FLAG3,b,4"
       print #2,"              2 FLAG4,b,4"
       print #2,"              2 FLAG5,b,4"
       print #2,"              2 ERTN,b,4"
       print #2,"              2 PORT,b,2"
       print #2,"              2 FILLER,x,330"
       print #2,"              2 FIELDS(128)"
       print #2,"                      3 FNAME,x,6"
       print #2,"                      3 FTYPE,x,1"
       print #2,"                      3 FSIZE,b,1"
       print #2,"end structure"
       print #2
       print #2,"structure key'packet"
       print #2,"      1 BUFFER"
       print #2,"              2 RECDNO,b,4"
       print #2,"              2 FLAG1,b,4"
       print #2,"              2 FLAG2,b,4"
       print #2,"              2 FLAG3,b,4"
       print #2,"              2 FLAG4,b,4"
       print #2,"              2 FLAG5,b,4"
       print #2,"              2 ERTN,b,4"
       print #2,"              2 PORT,b,2"
       print #2,"              2 FILLER,x,330"
       print #2,"end structure"
       print #2
       for loop=1 to num'dbs
               print #2,"dbms'packet "+dbs(loop)
       next loop
       for loop=1 to num'key
               print #2,"key'packet "+key(loop)
       next loop
       print #2,"!"
       for loop=1 to num'dbs
               print #2,"map1 "+dbs(loop)+",@"+dbs(loop)+"_BUFFER"
       next loop
       for loop=1 to num'key
               print #2,"map1 "+key(loop)+",@"+key(loop)+"_BUFFER"
       next loop
       close #2

       open #3,main'dbs'name+".opn",output
       for loop=1 to num'dbs
               print #3,"      open.file "+dbs(loop)+" named ";
               print #3,chr(34)+lcs(dbs(loop))+chr(34)
       next loop
       print #3,"!"
       for loop=1 to num'key
               print #3,"      open.key.file "+key(loop)+" named ";
               print #3,chr(34)+lcs(kyn(loop))+chr(34)
       next loop
       close #3

You are viewing proxied material from gopher.floodgap.com. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.