home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / DBOOK1_5.ZIP / GRPTEST.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-09-28  |  4.4 KB  |  150 lines
  1. Program GRPTest;
  2. {───────────────────────────────────────────────────────────────────┐
  3.  
  4.   This is a Test for Group Files. It will take an ascii file of Names
  5.   and phone numbers and convert it into a series of group files.  Take
  6.   out references to CAMPhone and USES statement to CFAX if you wish to
  7.   make this work for CFAX.
  8.  
  9.   Turbo Pascal 5.5
  10.   DOS 3.3
  11.   September 28, 1990
  12. └───────────────────────────────────────────────────────────────────}
  13.  
  14. Uses TPCRT,
  15.      TPString,
  16.      TPDate,
  17.      CCom;
  18.  
  19. Type
  20.   FileName = String[12];
  21.  
  22. VAR
  23.   Ascii   : Text;
  24.   AsciiName : FileName;
  25.   GroupID   : String[5];
  26.  
  27. Procedure ProcessError( error : integer;
  28.                         Locus : string);
  29. {───────────────────────────────────────────────────────────────────
  30.  This procedure processes errors and halts the program.  It should be
  31.  beefed up quite a bit, but for the sake of brevity I've merely included
  32.  it as a model upon which to build your own.
  33.  ───────────────────────────────────────────────────────────────────}
  34.  
  35. Begin
  36.   WriteLn;
  37.   Case error of
  38.     1..20  : WriteLn('Dos Error ', error:2, ', while ', Locus);
  39.   Else
  40.       Write('Problem ', error:4, ': ', Locus);
  41.   End;
  42.   Halt;
  43. End; { ProcessError }
  44.  
  45. Function OpenAscii (AsciiName : FileName) : Boolean;
  46. {───────────────────────────────────────────────────────────────────
  47.  This function opens the ascii file.
  48.  ───────────────────────────────────────────────────────────────────}
  49. VAR
  50.   err  : integer;
  51.  
  52. Begin
  53.   OpenAscii := False;
  54.   Assign(Ascii, AsciiName);
  55.   {$I-}
  56.   Reset(Ascii);
  57.   {$I+}
  58.   err := IoResult;
  59.   If err > 0
  60.     then ProcessError(err, 'Opening Ascii File.')
  61.     else OpenAscii := True
  62. End;  { OpenAscii }
  63.  
  64. Procedure OpenGroup(var GrpF : GroupFile;
  65.                         GroupNum : Integer);
  66. {─────────────────────────────────────────────────────────────────────
  67. This Procedure creates a Group List file whose name will follow the
  68. following conventions: GroupID : 5 letter ID tag 0 - 999 : up to 3 digit
  69. group number .GRP    : extension
  70. ─────────────────────────────────────────────────────────────────────}
  71. VAR GrpFName : FileName; S        : String[3]; err      : Integer;
  72.  
  73. Begin
  74.   Str(GroupNum, S);
  75.   GrpFName := StUpCase(GroupID + S + '.GRP');
  76.   WriteLn('Opening Group File Name: ', GrpFName);
  77.   Assign(GrpF, GrpFName);
  78.   {$I-}
  79.   Rewrite(GrpF,1);
  80.   {$I+}
  81.   err := IoResult;
  82.   If err > 0
  83.     then ProcessError(err, 'Opening Group file ' + GrpFName);
  84.  
  85. End;  { OpenGroup }
  86.  
  87.  
  88. Procedure MakeGroups;
  89. Const
  90.   CAMStr  = '';                            { blank CAMPhone }
  91.   PollStr = '';                            { blank Polling Password }
  92.   MaxCount = 99;                           { Maximum records per group }
  93.  
  94. VAR
  95.   Group : GroupFile;                       { Group handle }
  96.   OneRec : GrpRec;                         { One Group Record }
  97.   GroupLst : Array[1..99] of GrpRec;       { List of Group Members }
  98.   Count : Word;                          { Count of Members }
  99.   GroupNum : Integer;                      { number of groups processed }
  100.   i     : integer;                         { For loop counter }
  101.   break : boolean;
  102.  
  103. Begin
  104.   GroupNum := 0;
  105.   While Not EOF(Ascii) Do Begin
  106.     OpenGroup(Group, GroupNum);
  107.     WriteLn('Reading for ', StUpCase(GroupID), GroupNum);
  108.     Count := 0;
  109.     Break := False;
  110.     FillChar(GroupLst, SizeOf(GroupLst), $0);
  111.     While (Count < MaxCount) and not Break Do Begin
  112.     { reading in the group }
  113.       inc(Count);
  114.       Read(Ascii, OneRec.Name);
  115.       ReadLn(Ascii, OneRec.FAXPhone);
  116.  
  117.       OneRec.CAMPhone := CAMStr;
  118.       OneRec.PollPWD  := PollStr;
  119.       GroupLst[Count] := OneRec;
  120.       If EOF(Ascii) then Break := True;
  121.       Write(Count:2, ^M);
  122.     End;                                   { reading in the group }
  123.     WriteLn;
  124.  
  125.     If WriteGrpHdr(Group, Count)    { Write the list out to the group file }
  126.       then WriteLn('Writing ', StUpCase(GroupID), GroupNum)
  127.       else ProcessError(1099, 'Writing Group Header');
  128.     For i := 1 to Count do begin
  129.       PutGrpRec(Group, GroupLst[i]);
  130.       Write(i:2, ^M)
  131.     End; {for}
  132.     Close(Group);
  133.     inc(GroupNum);
  134.     WriteLn; WriteLn;
  135.   End; { while not eof }
  136. End; { MakeGroups }
  137.  
  138. Begin
  139.   Write('ASCII input file name: ');
  140.   ReadLn(AsciiName);
  141.   Write('Group ID [up to 5 letters]: ');
  142.   ReadLn(GroupID);
  143.   If OpenAscii(AsciiName) then
  144.     MakeGroups;
  145.   Close(Ascii);
  146.   WriteLn;
  147.   WriteLn(' The Conversion program has ended succesfully. ')
  148. End.
  149.  
  150.