home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / Pascal / Samples / ADDCOL.ARJ / ADDCOL.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-07-14  |  2.3 KB  |  91 lines
  1. PROGRAM AddColumnOfNumbersInFile;
  2. CONST
  3.      ProgData = 'ADDCOL- Free DOS utility: adds a column of numbers in a text file.';
  4.      ProgDat2 = 'V1.00: July 14, 1993. (c) 1993 by David Daniel Anderson - Reign Ware.';
  5.      Usage    = 'Usage: ADDCOL <file> [<column # start in> <column width>]';
  6.  
  7. VAR
  8.    NumbFile     : Text;
  9.  
  10.    CSumStr      : String[40];
  11.    CSum         : Real;
  12.  
  13.    StartLoc,
  14.    NumbLen      : Byte;
  15.    NumbersAdded : Word;
  16.  
  17.  
  18. PROCEDURE InitGVars;
  19. VAR ValERR     : Integer;
  20. BEGIN
  21.      Writeln(ProgData);
  22.      Writeln(ProgDat2);
  23.      Writeln;
  24.      Assign(NumbFile,ParamStr(1));
  25. {$I-} Reset(NumbFile); {$I+}
  26.      IF ((IOResult <> 0) OR (ParamCount = 0)) THEN
  27.      BEGIN
  28.           WriteLn(Usage);
  29.           Halt;
  30.      END;
  31.      IF (ParamCount = 3) THEN
  32.      BEGIN
  33.           Val(ParamStr(2),StartLoc,ValERR);
  34.           Val(ParamStr(3),NumbLen,ValERR);
  35.      END
  36.      ELSE BEGIN
  37.           StartLoc := 1;
  38.           NumbLen := 50;
  39.      END;
  40.      CSum := 0.0;
  41.      NumbersAdded := 0;
  42. END;
  43.  
  44. PROCEDURE AddTheNumbs;
  45. VAR
  46.    CNumbStr     : String[80];
  47.    CNumb        : Real;
  48.    ValERR       : Integer;
  49.    MaxLen       : Integer;
  50. BEGIN
  51.      MaxLen := StartLoc + NumbLen;
  52. REPEAT
  53.      ReadLn(NumbFile,CNumbStr);
  54.      IF (Length(CNumbStr) <> 0) THEN
  55.      BEGIN
  56.           Delete(CNumbStr,MaxLen,255);
  57.           WHILE (CNumbStr[Length(CNumbStr)] = ' ') DO
  58.              Delete(CNumbStr,Length(CNumbStr),1);
  59.           CNumbStr := Copy(CNumbStr,StartLoc,NumbLen);
  60.           Val(CNumbStr,CNumb,ValERR);
  61.           IF (ValERR = 0) THEN
  62.           BEGIN
  63.              CSum := CSum + CNumb;
  64.              Inc(NumbersAdded);
  65.           END;
  66.      END;
  67. UNTIL Eof (NumbFile);
  68.      Close(NumbFile);
  69. END;
  70.  
  71. FUNCTION NormalizeRealStr ( AbNormal : String ) : String;
  72. VAR LastChar : String[1];
  73. BEGIN
  74.      LastChar := Copy(AbNormal,Length(AbNormal),1);
  75.      WHILE LastChar = '0' DO
  76.      BEGIN
  77.           Delete(AbNormal,Length(AbNormal),1);
  78.           LastChar := Copy(AbNormal,Length(AbNormal),1);
  79.      END;
  80.      IF   Pos('.',AbNormal) = Length(AbNormal) THEN
  81.           Delete(AbNormal,Length(AbNormal),1);
  82.      NormalizeRealStr := AbNormal;
  83. END;
  84.  
  85. BEGIN
  86.      InitGVars;
  87.      AddTheNumbs;
  88.      Str(CSum:0:8, CSumStr);
  89.      WriteLn('The ',NumbersAdded,' numbers from "',ParamStr(1),'" total ',NormalizeRealStr(CSumStr));
  90. END.
  91.