home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / FILER.ZIP / FRMTODAT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-11-18  |  7.9 KB  |  229 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. TYPE
  32.   STRING130  =  STRING[130];
  33.   STRING80   =  STRING[80];
  34.   NAMESTR    =  STRING[12];
  35.  
  36. VAR
  37.   X  :  INTEGER;                  { POSITION IN SCREEN DATA LINE }
  38.   Y  :  INTEGER;                     { LABEL & DATA ARRAY NUMBER }
  39.   Z  :  INTEGER;                           { SCREEN LINE COUNTER }
  40.   W  :  INTEGER;
  41.   CODE, FIELDPERRECORD,RCDLEN     :  INTEGER;
  42.   BLOCKINGFACTOR                  :  INTEGER;
  43.  
  44.   FILEEXISTS                      :  BOOLEAN;
  45.  
  46.   LINE      :  ARRAY [1..30] OF STRING80;
  47.   WORK      :  ARRAY [1..80] OF CHAR;
  48.   BUFFER    :  ARRAY [1..128] OF CHAR;
  49.   LBL       :  ARRAY [1..384] OF CHAR;
  50.   CURRDATE  :  STRING[8];
  51.   FILENAME  :  STRING[12];
  52.   INFO      :  STRING130;
  53.   LABELNAME :  STRING130;
  54.   CH        :  CHAR;
  55.  
  56.   LABELLENGTH, DATALEN,DATAFORM,
  57.   ROW,COLUMN                           :  ARRAY[1..32] OF INTEGER;
  58.   LBLNAME                              :  ARRAY[1..32] OF STRING80;
  59.  
  60.   SCREENFORM                   : TEXT;
  61.   SOURCE                       : FILE;
  62.  
  63. {===============================================================}
  64. {                       FUNCTION EXIST                          }
  65. {===============================================================}
  66. FUNCTION EXIST(FILENAME : NAMESTR) : BOOLEAN;
  67. VAR
  68.   FIL :  FILE;
  69. BEGIN
  70.   ASSIGN(FIL,FILENAME);
  71.   {$I-}
  72.   RESET(FIL);
  73.   {$I+}
  74.   EXIST := (IORESULT = 0)
  75. END;
  76. {===============================================================}
  77. {                       MAIN PROGRAM                            }
  78. {===============================================================}
  79.  
  80. BEGIN
  81.   REPEAT
  82.     CLRSCR;
  83.     GOTOXY(1,24);
  84.     WRITELN('"FRMTODAT" CONVERTS FILE FROM XXX.FRM TO XXX.DAT');
  85.     WRITELN;
  86.     WRITE('ENTER FILENAME OF SOURCE FILE : ');
  87.     READLN(FILENAME);
  88.     X := POS('.',FILENAME);
  89.     IF X <> 0 THEN FILENAME := COPY(FILENAME,1,X-1);
  90.     FILENAME := FILENAME + '.FRM';
  91.     FILEEXISTS := EXIST(FILENAME);
  92.   UNTIL FILEEXISTS = TRUE;
  93.   ASSIGN (SCREENFORM,FILENAME);
  94.   RESET(SCREENFORM);
  95.   Z := 1;
  96.   WHILE NOT EOF(SCREENFORM) DO
  97.     BEGIN
  98.       READLN(SCREENFORM,LINE[Z]);
  99.       FOR X := 4 TO 32 DO
  100.         IF LINE[Z][X] = ' ' THEN LINE[Z][X] := '0';
  101.  
  102.       Y := POS('ROW',LINE[Z]) + 3;
  103.       INFO := '';
  104.       FOR X := Y TO Y+2 DO
  105.         INFO := INFO + LINE[Z][X];
  106.       VAL(INFO, ROW[Z], CODE);
  107.  
  108.       Y := POS('COL',LINE[Z]) + 3;
  109.       INFO := '';
  110.       FOR X := Y TO Y+2 DO
  111.         INFO := INFO + LINE[Z][X];
  112.       VAL(INFO, COLUMN[Z], CODE);
  113.  
  114.       Y := POS('FORM',LINE[Z]) + 4;
  115.       INFO := '';
  116.       FOR X := Y TO Y+2 DO
  117.         INFO := INFO + LINE[Z][X];
  118.       VAL(INFO, DATAFORM[Z], CODE);
  119.  
  120.       Y := POS('LEN',LINE[Z]) + 3;
  121.       INFO := '';
  122.       FOR X := Y TO Y+3 DO
  123.         INFO := INFO + LINE[Z][X];
  124.       VAL(INFO, DATALEN[Z], CODE);
  125.  
  126.       Y := POS('>',LINE[Z]) + 1;
  127.       W := POS('<',LINE[Z]) - 1;
  128.       LBLNAME[Z] := '';
  129.       FOR X := Y TO W DO
  130.       LBLNAME[Z] := LBLNAME[Z] + LINE[Z][X];
  131.  
  132.       Z := Z+1;
  133.     END;
  134.     FIELDPERRECORD := Z-1;
  135.     FOR Z := 1 TO FIELDPERRECORD DO
  136.       BEGIN
  137.         WRITE('ROW',ROW[Z]:3,', COL',COLUMN[Z]:3);
  138.         WRITE(', FORM',DATAFORM[Z]:3,', LEN',DATALEN[Z]:4);
  139.         WRITELN(', MISC ___, LABEL >',LBLNAME[Z],'<');
  140.       END;
  141.     CLOSE(SCREENFORM);
  142.     WRITELN;
  143.  
  144. {===============================================================}
  145. {                   BUILD NEW FILE HEADER                       }
  146. {===============================================================}
  147.   X := POS('.',FILENAME);
  148.   IF X <> 0 THEN FILENAME := COPY(FILENAME,1,X);
  149.   FILENAME := FILENAME + 'DAT';
  150.   WRITE('ENTER CURRENT DATE (MM/DD/YY : ');
  151.   READLN(CURRDATE);
  152.  
  153.   ASSIGN(SOURCE,FILENAME);
  154.   REWRITE(SOURCE);
  155.   FOR X := 1 TO 128 DO
  156.     BUFFER[X] := CHR(0);
  157.   BUFFER[2] := CHR(1);
  158.   BUFFER[3] := CHR(3);
  159.   SEEK(SOURCE,0);
  160.   BLOCKWRITE(SOURCE,BUFFER,1);             { WRITE BASIC/Z BLOCK }
  161.  
  162.   FOR X := 1 TO 128 DO                       { INITIALIZE BUFFER }
  163.     BUFFER[X] := '0';
  164.   FOR X := 1 TO 6 DO
  165.     BUFFER[X] := FILENAME[X];                         { FILE NAME }
  166.   RCDLEN := 0;
  167.   FOR X := 1 TO FIELDPERRECORD DO
  168.     RCDLEN := RCDLEN + DATALEN[X];
  169.   STR(RCDLEN:3,INFO);
  170.   FOR X := 15 TO 17 DO
  171.     BUFFER[X] := INFO[X-14];                     { RECORD LENGTH }
  172.   BLOCKINGFACTOR := 256 DIV RCDLEN;
  173.   STR(BLOCKINGFACTOR:2,INFO);
  174.   FOR X := 18 TO 19 DO
  175.     BUFFER[X] := INFO[X-17];                   { BLOCKING FACTOR }
  176.   STR(FIELDPERRECORD:2,INFO);
  177.   FOR X := 20 TO 21 DO
  178.     BUFFER[X] := INFO[X-19];                  { FIELD PER RECORD }
  179.   FOR X := 22 TO 29 DO
  180.     BUFFER[X] := CURRDATE[X-21];                  { CURRENT DATE }
  181.   FOR X := 15 TO 29 DO
  182.       IF BUFFER[X] = ' ' THEN BUFFER[X] := '0';
  183.   FOR X := 30 TO 32 DO
  184.     BUFFER[X] := ' ';
  185.  
  186.   FOR X := 1 TO FIELDPERRECORD DO                { LABEL LENGTHS }
  187.     BUFFER[32+X] := CHR((LENGTH(LBLNAME[X]) DIV 10)*6 + LENGTH(LBLNAME[X]));
  188.   FOR X := 1 TO FIELDPERRECORD DO                 { DATA LENGTHS }
  189.     BUFFER[64+X] := CHR((DATALEN[X] DIV 10)*6 + DATALEN[X]);
  190.   FOR X := 1 TO FIELDPERRECORD DO                    { DATA FORM }
  191.     BUFFER[96+X] := CHR(DATAFORM[X] + 48);                
  192.   BLOCKWRITE(SOURCE,BUFFER,1);
  193.  
  194.   FOR X := 1 TO 384 DO
  195.     LBL[X] := CHR(0);                  { INITIALIZE LABEL BUFFER }
  196.   Z := 1;
  197.   FOR Y := 1 TO FIELDPERRECORD DO
  198.     BEGIN
  199.       FOR X := 1 TO LENGTH(LBLNAME[Y]) DO
  200.         BEGIN
  201.           LBL[Z] := LBLNAME[Y][X];
  202.           Z := Z + 1;
  203.         END;
  204.     END;
  205.   BLOCKWRITE(SOURCE,LBL,3);                       { WRITE LABELS }
  206.  
  207.   FOR X := 1 TO 128 DO
  208.     BUFFER[X] := CHR(0);                     { INITIALIZE BUFFER }
  209.   BUFFER[1] := 'V';                        { VERSION 2.0 MESSAGE }
  210.   BUFFER[2] := '2';
  211.   BUFFER[3] := '.';
  212.   BUFFER[4] := '0';
  213.   FOR X := 1 TO FIELDPERRECORD DO
  214.     BEGIN                                { ROW & COL & MISC INFO }
  215.       BUFFER[1+X*4] := CHR(ROW[X]+( ROW[X] DIV 10 )*6);
  216.       BUFFER[2+X*4] := CHR(((COLUMN[X] DIV 10) DIV 10)*6+(COLUMN[X] DIV 10));
  217.       BUFFER[3+X*4] := CHR((COLUMN[X]-((COLUMN[X] DIV 10)*10)) * 16);
  218.       BUFFER[4+X*4] := CHR(255);
  219.     END;
  220.   BLOCKWRITE(SOURCE,BUFFER,1);
  221.   FOR X := 1 TO 128 DO
  222.     BUFFER[X] := ' ';                        { INITIALIZE BUFFER }
  223.   FOR X := 1 TO 3 DO
  224.     BLOCKWRITE(SOURCE,BUFFER,1);
  225.   CLOSE(SOURCE);
  226.   WRITELN;
  227.   WRITELN(FILENAME,' HAS BEEN CREATED FOR USE WITH FILER PROGRAMS.');
  228. END.
  229.