home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / MADTRB36.ZIP / FRMTODAT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-02-09  |  8.2 KB  |  239 lines
  1.  
  2. (***************************************************************)
  3. (*                                                             *)
  4. (*        FILER A LA PASCAL DATA BASE SOURCE CODE FILE         *)
  5. (*                                                             *)
  6. (*        (C) 1985 by  John M. Harlan                          *)
  7. (*                     24000 Telegraph                         *)
  8. (*                     Southfield, MI. 48034                   *)
  9. (*                                                             *)
  10. (*     The FILER GROUP of programs is released on a "FREE      *)
  11. (*     SOFTWARE" basis.  The recipient is free to examine      *)
  12. (*     and use the software with the understanding that if     *)
  13. (*     the FILER GROUP of programs prove to be of use and      *)
  14. (*     value,  a contribution to the author is encouraged.     *)
  15. (*                                                             *)
  16. (*     While reasonable effort has been made to ensure the     *)
  17. (*     reliability of the FILER GROUP of programs, no war-     *)
  18. (*     ranty is given. The recipient uses the programs at      *)
  19. (*     his own risk  and in no event shall the author be       *)
  20. (*     liable for damages arising from their use.              *)
  21. (*                                                             *)
  22. (*                                                             *)
  23. (***************************************************************)
  24.  
  25.  
  26. program frmtodat; { ONE OF THE FILER GROUP OF PROGRAMS }
  27. { PROGRAM TO TRANSLATE FROM .FRM TO .DAT FILE }
  28. { FRMTODAT.PAS  VERSION 2.0 }
  29. { NOV 15, 1984 }
  30.  
  31. { Formatted 2/7/86 by Doug Stevens using Pformat and the Turbo
  32.   editors global search/replace. Original version was 100%
  33.   upper case and very hard to read. }
  34.  
  35. label QUIT;
  36.  
  37. type
  38.   String130  =  string[130];
  39.   String80   =  string[80];
  40.   NameStr    =  string[12];
  41.  
  42. var
  43.   x  :  integer;                  { POSITION IN SCREEN DATA LINE }
  44.   y  :  integer;                     { LABEL & DATA ARRAY NUMBER }
  45.   z  :  integer;                           { SCREEN LINE COUNTER }
  46.   w  :  integer;
  47.   code, fieldperrecord,rcdlen     :  integer;
  48.   blockingfactor                  :  integer;
  49.  
  50.   fileexists                      :  boolean;
  51.  
  52.   line      :  array [1..30] of String80;
  53.   work      :  array [1..80] of char;
  54.   buffer    :  array [1..128] of char;
  55.   lbl       :  array [1..384] of char;
  56.   currdate  :  string[8];
  57.   filename  :  string[12];
  58.   info      :  String130;
  59.   labelname :  String130;
  60.   ch        :  char;
  61.  
  62.   labellength, datalen,dataform,
  63.   row,column                           :  array[1..32] of integer;
  64.   lblname                              :  array[1..32] of String80;
  65.  
  66.   screenform                   : text;
  67.   source                       : file;
  68.  
  69. {===============================================================}
  70. {                       FUNCTION EXIST                          }
  71. {===============================================================}
  72. function Exist(filename : NameStr) : boolean;
  73. var
  74.   fil    :  file;
  75.   status : integer;
  76. begin
  77.   Assign(fil,filename);
  78.   {$I-}
  79.   reset(fil);
  80.   {$I+}
  81.   Exist := (IOResult = 0);
  82. {$I-} Close(fil); status := IOResult; {$I+}
  83. end;
  84. {===============================================================}
  85. {                       MAIN PROGRAM                            }
  86. {===============================================================}
  87.  
  88. begin
  89.   repeat
  90.     ClrScr;
  91.     GotoXY(1,24);
  92.     writeln('"FRMTODAT" CONVERTS FILE FROM XXX.FRM TO XXX.DAT');
  93.     writeln;
  94.     write('ENTER FILENAME OF SOURCE FILE : ');
  95.     readln(filename);
  96.     x := pos('.',filename);
  97.     if x <> 0 then filename := copy(filename,1,x-1);
  98.     if filename = 'END' then goto QUIT; { Quick and dirty exit }
  99.     filename := filename + '.FRM';
  100.     fileexists := Exist(filename);
  101.   until fileexists = true;
  102.   Assign (screenform,filename);
  103.   reset(screenform);
  104.   z := 1;
  105.   while not eof(screenform) do
  106.     begin
  107.       readln(screenform,line[z]);
  108.       for x := 4 to 32 do
  109.         if line[z][x] = ' ' then line[z][x] := '0';
  110.  
  111.       y := pos('ROW',line[z]) + 3;
  112.       info := '';
  113.       for x := y to y+2 do
  114.         info := info + line[z][x];
  115.       val(info, row[z], code);
  116.  
  117.       y := pos('COL',line[z]) + 3;
  118.       info := '';
  119.       for x := y to y+2 do
  120.         info := info + line[z][x];
  121.       val(info, column[z], code);
  122.  
  123.       y := pos('FORM',line[z]) + 4;
  124.       info := '';
  125.       for x := y to y+2 do
  126.         info := info + line[z][x];
  127.       val(info, dataform[z], code);
  128.  
  129.       y := pos('LEN',line[z]) + 3;
  130.       info := '';
  131.       for x := y to y+3 do
  132.         info := info + line[z][x];
  133.       val(info, datalen[z], code);
  134.  
  135.       y := pos('>',line[z]) + 1;
  136.       w := pos('<',line[z]) - 1;
  137.       lblname[z] := '';
  138.       for x := y to w do
  139.       lblname[z] := lblname[z] + line[z][x];
  140.  
  141.       z := z+1;
  142.     end;
  143.     fieldperrecord := z-1;
  144.     for z := 1 to fieldperrecord do
  145.       begin
  146.         write('ROW',row[z]:3,', COL',column[z]:3);
  147.         write(', FORM',dataform[z]:3,', LEN',datalen[z]:4);
  148.         writeln(', MISC ___, LABEL >',lblname[z],'<');
  149.       end;
  150.     close(screenform);
  151.     writeln;
  152.  
  153. {===============================================================}
  154. {                   BUILD NEW FILE HEADER                       }
  155. {===============================================================}
  156.   x := pos('.',filename);
  157.   if x <> 0 then filename := copy(filename,1,x);
  158.   filename := filename + 'DAT';
  159.   write('ENTER CURRENT DATE (MM/DD/YY : ');
  160.   readln(currdate);
  161.  
  162.   Assign(source,filename);
  163.   rewrite(source);
  164.   for x := 1 to 128 do
  165.     buffer[x] := chr(0);
  166.   buffer[2] := chr(1);
  167.   buffer[3] := chr(3);
  168.   Seek(source,0);
  169.   blockwrite(source,buffer,1);             { WRITE BASIC/Z BLOCK }
  170.  
  171.   for x := 1 to 128 do                       { INITIALIZE BUFFER }
  172.     buffer[x] := '0';
  173.   for x := 1 to 6 do
  174.     buffer[x] := filename[x];                         { FILE NAME }
  175.   rcdlen := 0;
  176.   for x := 1 to fieldperrecord do
  177.     rcdlen := rcdlen + datalen[x];
  178.   str(rcdlen:3,info);
  179.   for x := 15 to 17 do
  180.     buffer[x] := info[x-14];                     { RECORD LENGTH }
  181.   blockingfactor := 256 div rcdlen;
  182.   str(blockingfactor:2,info);
  183.   for x := 18 to 19 do
  184.     buffer[x] := info[x-17];                   { BLOCKING FACTOR }
  185.   str(fieldperrecord:2,info);
  186.   for x := 20 to 21 do
  187.     buffer[x] := info[x-19];                  { FIELD PER RECORD }
  188.   for x := 22 to 29 do
  189.     buffer[x] := currdate[x-21];                  { CURRENT DATE }
  190.   for x := 15 to 29 do
  191.       if buffer[x] = ' ' then buffer[x] := '0';
  192.   for x := 30 to 32 do
  193.     buffer[x] := ' ';
  194.  
  195.   for x := 1 to fieldperrecord do                { LABEL LENGTHS }
  196.     buffer[32+x] := chr((length(lblname[x]) div 10)*6 + length(lblname[x]));
  197.   for x := 1 to fieldperrecord do                 { DATA LENGTHS }
  198.     buffer[64+x] := chr((datalen[x] div 10)*6 + datalen[x]);
  199.   for x := 1 to fieldperrecord do                    { DATA FORM }
  200.     buffer[96+x] := chr(dataform[x] + 48);                
  201.   blockwrite(source,buffer,1);
  202.  
  203.   for x := 1 to 384 do
  204.     lbl[x] := chr(0);                  { INITIALIZE LABEL BUFFER }
  205.   z := 1;
  206.   for y := 1 to fieldperrecord do
  207.     begin
  208.       for x := 1 to length(lblname[y]) do
  209.         begin
  210.           lbl[z] := lblname[y][x];
  211.           z := z + 1;
  212.         end;
  213.     end;
  214.   blockwrite(source,lbl,3);                       { WRITE LABELS }
  215.  
  216.   for x := 1 to 128 do
  217.     buffer[x] := chr(0);                     { INITIALIZE BUFFER }
  218.   buffer[1] := 'V';                        { VERSION 2.0 MESSAGE }
  219.   buffer[2] := '2';
  220.   buffer[3] := '.';
  221.   buffer[4] := '0';
  222.   for x := 1 to fieldperrecord do
  223.     begin                                { ROW & COL & MISC INFO }
  224.       buffer[1+x*4] := chr(row[x]+( row[x] div 10 )*6);
  225.       buffer[2+x*4] := chr(((column[x] div 10) div 10)*6+(column[x] div 10));
  226.       buffer[3+x*4] := chr((column[x]-((column[x] div 10)*10)) * 16);
  227.       buffer[4+x*4] := chr(255);
  228.     end;
  229.   blockwrite(source,buffer,1);
  230.   for x := 1 to 128 do
  231.     buffer[x] := ' ';                        { INITIALIZE BUFFER }
  232.   for x := 1 to 3 do
  233.     blockwrite(source,buffer,1);
  234.   close(source);
  235.   writeln;
  236.   writeln(filename,' HAS BEEN CREATED FOR USE WITH FILER PROGRAMS.');
  237. QUIT:
  238. end.
  239.