home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / PIBTERM / PIBT41S1.ARC / CNFUPDAT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-02-21  |  21.2 KB  |  508 lines
  1. (*$R-,V-,S-,I-,F+*)
  2. PROGRAM CnfUpDate;
  3.  
  4. USES
  5.    Dos;
  6.  
  7. (*----------------------------------------------------------------------*)
  8. (*                                                                      *)
  9. (*     Program:    CnfUpDate;                                           *)
  10. (*                                                                      *)
  11. (*     Purpose:    Updates pre-v4.1 PIBTERM.CNF files to v4.1 specs.    *)
  12. (*                                                                      *)
  13. (*     Author:     Philip R. Burns                                      *)
  14. (*                                                                      *)
  15. (*     Version:    1.0.  January 5, 1988.                               *)
  16. (*                 1.1.  February 21, 1988.  For initial PTv4.1 release.*)
  17. (*                                                                      *)
  18. (*     Use:                                                             *)
  19. (*                                                                      *)
  20. (*        At the DOS prompt enter:                                      *)
  21. (*                                                                      *)
  22. (*           CNFUPDAT cnfname                                           *)
  23. (*                                                                      *)
  24. (*        where "cnfname" is the name of the .CNF file to be            *)
  25. (*        converted WITHOUT the terminating ".CNF" specified.           *)
  26. (*        If "cnfname" is not specified, then "PIBTERM"                 *)
  27. (*        is used as a default name.  If a '?' is entered for           *)
  28. (*        "cnfname", then a brief help note is displayed.               *)
  29. (*                                                                      *)
  30. (*        The old file is renamed to "cnfname.CNO" and the new file is  *)
  31. (*        written to "cnfname.CNF".                                     *)
  32. (*                                                                      *)
  33. (*        For example, if                                               *)
  34. (*                                                                      *)
  35. (*           CNFUPDAT  PIBTERM                                          *)
  36. (*                                                                      *)
  37. (*        is entered, then  PIBTERM.CNF is renamed to PIBTERM.CNO,      *)
  38. (*        and the new file is PIBTERM.CNF.                              *)
  39. (*                                                                      *)
  40. (*----------------------------------------------------------------------*)
  41.  
  42. TYPE
  43.    AnyStr  = STRING[255];
  44.    TextBuf = ARRAY[1..4096] OF CHAR;
  45.  
  46. VAR
  47.    New_Config_File : TEXT;
  48.    Old_Config_File : TEXT;
  49.  
  50.    New_Config_File_Buffer : TextBuf;
  51.    Old_Config_File_Buffer : TextBuf;
  52.  
  53.    New_Config_File_Name   : AnyStr;
  54.    Old_Config_File_Name   : AnyStr;
  55.  
  56.    File_Path              : AnyStr;
  57.  
  58.    New_Open               : BOOLEAN;
  59.    Old_Open               : BOOLEAN;
  60.  
  61.    Config_Line            : AnyStr;
  62.    Param_Name             : String[2];
  63.  
  64. (*----------------------------------------------------------------------*)
  65.  
  66. PROCEDURE Close_Files;
  67.  
  68. VAR
  69.    Ierr : INTEGER;
  70.  
  71. BEGIN (* Close_Files *)
  72.  
  73.    IF Old_Open THEN
  74.       BEGIN
  75.          CLOSE( Old_Config_File );
  76.          Ierr := IOResult;
  77.       END;
  78.  
  79.    IF New_Open THEN
  80.       BEGIN
  81.           CLOSE( New_Config_File );
  82.           Ierr := IOResult;
  83.       END;
  84.  
  85. END   (* Close_Files *);
  86.  
  87. (*----------------------------------------------------------------------*)
  88.  
  89. PROCEDURE Check_Error( S : AnyStr );
  90.  
  91. BEGIN (* Check_Error *)
  92.  
  93.    IF ( IOResult <> 0 ) THEN
  94.       BEGIN
  95.  
  96.          WRITELN;
  97.          WRITELN( S , ', conversion abandoned.' );
  98.  
  99.          Close_Files;
  100.  
  101.          Halt( 1 );
  102.  
  103.       END;
  104.  
  105. END   (* Check_Error *);
  106.  
  107. (*----------------------------------------------------------------------*)
  108.  
  109. PROCEDURE Display_Help;
  110.  
  111. BEGIN (* Display_Help *)
  112.  
  113.    WRITELN( ' ' );
  114.    WRITELN( 'Program:    CnfUpDate' );
  115.    WRITELN( 'Purpose:    Updates pre-v4.1 PIBTERM.CNF files to v4.1 specs.' );
  116.    WRITELN( 'Author:     Philip R. Burns' );
  117.    WRITELN( 'Version:    1.1.  February 21, 1988.');
  118.    WRITELN( 'Use:');
  119.    WRITELN( '      CNFUPDAT cnfname' );
  120.    WRITELN( 'where "cnfname" is the name of the .CNF file to be');
  121.    WRITELN( 'converted WITHOUT the terminating ".CNF" specified.');
  122.    WRITELN( 'If "cnfname" is not specified, then "PIBTERM"');
  123.    WRITELN( 'is used as a default name.  If a "?" is entered for');
  124.    WRITELN( '"cnfname", then a brief help note is displayed.');
  125.    WRITELN( ' ');
  126.    WRITELN( 'The old file is renamed to "cnfname.CNO" and the new file is');
  127.    WRITELN( 'written to "cnfname.CNF".');
  128.    WRITELN( ' ' );
  129.    WRITELN( 'Example:');
  130.    WRITELN( '      CNFUPDAT  PIBTERM');
  131.    WRITELN( 'causes PIBTERM.CNF to be renamed to PIBTERM.CNO, and the');
  132.    WRITELN( 'updated configuration file is written to PIBTERM.CNF.');
  133.  
  134. END    (* Display_Help *);
  135.  
  136. (*----------------------------------------------------------------------*)
  137.  
  138. PROCEDURE Get_File_Names;
  139.  
  140. VAR
  141.    I        : INTEGER;
  142.    L        : INTEGER;
  143.  
  144. BEGIN (* Get_File_Names *)
  145.                                       (* No files open yet *)
  146.    Old_Open  := FALSE;
  147.    New_Open  := FALSE;
  148.    File_Path := '';
  149.                                       (* Get old config file name *)
  150.    IF ( ParamCount > 0 ) THEN
  151.       Old_Config_File_Name := ParamStr( 1 )
  152.    ELSE
  153.       Old_Config_File_Name := 'PIBTERM.CNF';
  154.  
  155.                                       (* See if help request *)
  156.  
  157.    IF ( Old_Config_File_Name = '?' ) THEN
  158.       BEGIN
  159.          Display_Help;
  160.          Halt( 0 );
  161.       END;
  162.                                       (* Convert name to upper case *)
  163.  
  164.    L := LENGTH( Old_Config_File_Name );
  165.  
  166.    FOR I := 1 TO L DO
  167.       Old_Config_File_Name[I] := UpCase( Old_Config_File_Name[I] );
  168.  
  169.                                       (* Remove file extension  *)
  170.  
  171.    I := POS( '.' , Old_Config_File_Name );
  172.  
  173.    IF ( I > 0 ) THEN
  174.       Old_Config_File_Name := COPY( Old_Config_File_Name, 1, PRED( I ) );
  175.  
  176.                                       (* Extract path if any    *)
  177.  
  178.    IF ( ( POS( ':' , Old_Config_File_Name ) <> 0 ) OR
  179.         ( POS( '\' , Old_Config_File_Name ) <> 0 ) ) THEN
  180.       BEGIN
  181.          I := L;
  182.          WHILE( ( Old_Config_File_Name[I] <> ':' ) AND
  183.                 ( Old_Config_File_Name[I] <> '\' ) ) DO
  184.             DEC( I );
  185.          File_Path            := COPY( Old_Config_File_Name, 1, I );
  186.          Old_Config_File_Name := COPY( Old_Config_File_Name, SUCC( I ), 255 );
  187.       END;
  188.                                       (* Form old and new names *)
  189.  
  190.    New_Config_File_Name := File_Path + Old_Config_File_Name + '.CNF';
  191.    Old_Config_File_Name := File_Path + Old_Config_File_Name + '.CNO';
  192.  
  193. END    (* Get_File_Names *);
  194.  
  195. (*----------------------------------------------------------------------*)
  196.  
  197. PROCEDURE Open_Files;
  198.  
  199. BEGIN (* Open_Files *)
  200.                                    (* Assign old config file and *)
  201.                                    (* rename to PIBTERM.CNO      *)
  202.  
  203.    ASSIGN( Old_Config_File , New_Config_File_Name );
  204.    RENAME( Old_Config_File , Old_Config_File_Name );
  205.  
  206.    Check_Error('Can not rename ' + New_Config_File_Name + ' to ' +
  207.                Old_Config_File_Name );
  208.  
  209.    WRITELN('The old configuration file ',New_Config_File_Name,
  210.            ' has been renamed ',Old_Config_File_Name);
  211.  
  212.                                    (* Rename worked -- open old config file *)
  213.  
  214.    SetTextBuf( Old_Config_File , Old_Config_File_Buffer );
  215.    RESET( Old_Config_File );
  216.  
  217.    Check_Error('Can not open old ' + Old_Config_File_Name + ' file');
  218.  
  219.    Old_Open := TRUE;
  220.                                    (* Assign new configuration file *)
  221.  
  222.    ASSIGN( New_Config_File , New_Config_File_Name );
  223.    SetTextBuf( New_Config_File , New_Config_File_Buffer );
  224.    REWRITE( New_Config_File );
  225.  
  226.    Check_Error('Can not open new ' + New_Config_File_Name + ' file');
  227.  
  228.    New_Open := TRUE;
  229.  
  230. END   (* Open_Files *);
  231.  
  232. (*----------------------------------------------------------------------*)
  233. (*             Write_Ctrls --- Convert ctrl key defs in string          *)
  234. (*----------------------------------------------------------------------*)
  235.  
  236. FUNCTION Write_Ctrls( S : AnyStr ) : AnyStr;
  237.  
  238. (*----------------------------------------------------------------------*)
  239. (*                                                                      *)
  240. (*     Function:   Write_Ctrls                                          *)
  241. (*                                                                      *)
  242. (*     Purpose:    Convert ctrl key defs to ascii sequences             *)
  243. (*                                                                      *)
  244. (*     Calling Sequence:                                                *)
  245. (*                                                                      *)
  246. (*        Fixed_S := Write_Ctrls( S: AnyStr ) : AnyStr;                 *)
  247. (*                                                                      *)
  248. (*           S       --- the string with potential ctrl seqs to convert *)
  249. (*           Fixed_S --- fixed up string                                *)
  250. (*                                                                      *)
  251. (*     Remarks:                                                         *)
  252. (*                                                                      *)
  253. (*        This routine replaces control sequences like ^G (ascii 07)    *)
  254. (*        with a two-character sequence like '^G' -- ascii 94 +         *)
  255. (*        ascii 71. The actual '^' character                            *)
  256. (*        is the global parameter FK_Ctrl_Mark and can be set with      *)
  257. (*        a configuration file.                                         *)
  258. (*                                                                      *)
  259. (*----------------------------------------------------------------------*)
  260.  
  261. VAR
  262.    T: AnyStr;
  263.    I: INTEGER;
  264.    J: INTEGER;
  265.  
  266. BEGIN (* Write_Ctrls *)
  267.                                    (* Scan for ctrl characters *)
  268.    T    := '';
  269.    J    := 0;
  270.  
  271.    FOR I := 1 TO LENGTH( S ) DO
  272.       BEGIN                        (* Ctrl char --- convert to marker  *)
  273.                                    (* plus ascii character             *)
  274.  
  275.          IF ( S[I] IN [^@..^_] ) THEN
  276.             BEGIN
  277.                INC( J );
  278.                T[J] := '^';
  279.                INC( J );
  280.                T[J] := CHR( ORD( S[I] ) + 64 );
  281.             END
  282.  
  283.                                    (* Regular character -- just copy *)
  284.          ELSE
  285.             BEGIN
  286.                INC( J );
  287.                T[J] := S[I];
  288.             END;
  289.       END;
  290.  
  291.    T[0]        := CHR( J );
  292.    Write_Ctrls := T;
  293.  
  294. END   (* Write_Ctrls *);
  295.  
  296. (*--------------------------------------------------------------------------*)
  297. (*               Trim --- Trim trailing blanks from a string                *)
  298. (*--------------------------------------------------------------------------*)
  299.  
  300. FUNCTION Trim( S : AnyStr ) : AnyStr;
  301.  
  302. (*--------------------------------------------------------------------------*)
  303. (*                                                                          *)
  304. (*     Function:   Trim                                                     *)
  305. (*                                                                          *)
  306. (*     Purpose:    Trims trailing blanks from a string                      *)
  307. (*                                                                          *)
  308. (*     Calling sequence:                                                    *)
  309. (*                                                                          *)
  310. (*         Trimmed_S := TRIM( S );                                          *)
  311. (*                                                                          *)
  312. (*            S          --- the string to be trimmed                       *)
  313. (*            Trimmed_S  --- the trimmed version of S                       *)
  314. (*                                                                          *)
  315. (*     Calls:  None                                                         *)
  316. (*                                                                          *)
  317. (*     Remarks:                                                             *)
  318. (*                                                                          *)
  319. (*        Note that the original string itself is left untrimmed.           *)
  320. (*                                                                          *)
  321. (*     Pascal version might be written as:                                  *)
  322. (*                                                                          *)
  323. (*        VAR                                                               *)
  324. (*           I:       INTEGER;                                              *)
  325. (*                                                                          *)
  326. (*        BEGIN                                                             *)
  327. (*                                                                          *)
  328. (*           I := ORD( S[0] );                                              *)
  329. (*                                                                          *)
  330. (*           WHILE ( I > 0 ) AND ( S[I] = ' ' ) DO                          *)
  331. (*              I := PRED( I );                                             *)
  332. (*                                                                          *)
  333. (*           S[0] := CHR( I );                                              *)
  334. (*           Trim := S;                                                     *)
  335. (*                                                                          *)
  336. (*        END;                                                              *)
  337. (*                                                                          *)
  338. (*--------------------------------------------------------------------------*)
  339.  
  340. BEGIN (* Trim *)
  341.  
  342. INLINE(
  343.   $1E/                   {         PUSH    DS                ; Save DS}
  344.                          {;}
  345.   $C5/$76/$06/           {         LDS     SI,[BP+6]         ; Get address of S}
  346.   $FC/                   {         CLD                       ; Forward search}
  347.   $AC/                   {         LODSB                     ; Get length of S}
  348.   $3C/$00/               {         CMP     AL,0              ; See if length 0}
  349.   $74/$21/               {         JE      Trim2             ; If so, no trimming required}
  350.                          {;}
  351.   $30/$ED/               {         XOR     CH,CH}
  352.   $88/$C1/               {         MOV     CL,AL             ; Remember length for search loop}
  353.                          {;}
  354.   $B0/$20/               {         MOV     AL,' '            ; Blank to AL}
  355.                          {;}
  356.   $C4/$7E/$06/           {         LES     DI,[BP+6]         ; Get address of S}
  357.   $01/$CF/               {         ADD     DI,CX             ; Point to end of source string}
  358.                          {;}
  359.   $FD/                   {         STD                       ; Backwards search}
  360.   $F3/$AE/               {         REPE    SCASB             ; Scan over blanks}
  361.   $74/$01/               {         JE      Trim1             ; If CX=0, entire string is blank.}
  362.   $41/                   {         INC     CX}
  363.                          {;}
  364.   $88/$C8/               {Trim1:   MOV     AL,CL             ; Length to copy}
  365.   $C5/$76/$06/           {         LDS     SI,[BP+6]         ; Source string address}
  366.   $46/                   {         INC     SI                ; Skip length}
  367.   $C4/$7E/$0A/           {         LES     DI,[BP+10]        ; Result string address}
  368.   $FC/                   {         CLD                       ; Forward move}
  369.   $AA/                   {         STOSB                     ; Set length in result}
  370.   $F2/$A4/               {         REP     MOVSB             ; Move trimmed result}
  371.   $E9/$04/$00/           {         JMP     Exit}
  372.                          {;}
  373.   $C4/$7E/$0A/           {Trim2:   LES     DI,[BP+10]        ; Result string address}
  374.   $AA/                   {         STOSB                     ; Set length=0 in result}
  375.                          {;}
  376.   $1F);                  {Exit:    POP     DS                ; Restore DS}
  377.  
  378. END   (* Trim *);
  379.  
  380. (*----------------------------------------------------------------------*)
  381.  
  382. PROCEDURE Convert_Config_File;
  383.  
  384. VAR
  385.    Config_Line : AnyStr;
  386.    Param_Name  : String[2];
  387.    PD_Count    : INTEGER;
  388.    Int_Val     : LONGINT;
  389.    L           : INTEGER;
  390.    I           : INTEGER;
  391.    YM_Seen     : BOOLEAN;
  392.    ZM_Seen     : BOOLEAN;
  393.  
  394. BEGIN (* Convert_Config_File *)
  395.                                    (* No external transfer guys found yet *)
  396.    PD_Count := 0;
  397.    YM_Seen  := FALSE;
  398.    ZM_Seen  := FALSE;
  399.                                    (* Read old config file and     *)
  400.                                    (* convert parameters as needed *)
  401.    REPEAT
  402.                                    (* Read line from old config file *)
  403.  
  404.       READLN( Old_Config_File , Config_Line );
  405.  
  406.       Check_Error('Can not read line from old configuration file' );
  407.  
  408.                                    (* Make sure it's legal format *)
  409.  
  410.       IF ( LENGTH( Config_Line ) > 2 ) THEN
  411.          IF ( Config_Line[3] = '=' ) THEN
  412.             BEGIN
  413.                                    (* Get param name. If one we are *)
  414.                                    (* checking, process it.         *)
  415.  
  416.                Param_Name  := Config_Line[1] + Config_Line[2];
  417.                Config_Line := TRIM( COPY( Config_Line, 4, LENGTH( Config_Line ) - 3 ) );
  418.                L           := LENGTH( Config_Line );
  419.  
  420.                IF      ( Param_Name = 'PD' ) THEN
  421.                   BEGIN
  422.                      Param_Name := 'Z' + CHR( ORD( '0' ) + PD_Count );
  423.                      PD_Count   := SUCC( PD_Count );
  424.                      YM_Seen    := YM_Seen OR ( COPY( Config_Line, 1, 2 ) = 'YM' );
  425.                      ZM_Seen    := ZM_Seen OR ( COPY( Config_Line, 1, 2 ) = 'ZM' );
  426.                   END
  427.                ELSE IF ( ( Param_Name = 'BS' ) OR
  428.                          ( Param_Name = 'DE' )  ) THEN
  429.                   BEGIN
  430.                      IF ( L > 0 ) THEN
  431.                         BEGIN
  432.                            I       := 1;
  433.                            Int_Val := 0;
  434.                            WHILE ( ( I <= L ) AND
  435.                                    ( Config_Line[I] IN ['0'..'9'] ) ) DO
  436.                               BEGIN
  437.                                  Int_Val := Int_Val * 10 + ORD( Config_Line[I] ) - ORD( '0' );
  438.                                  INC( I );
  439.                               END;
  440.                            Config_Line := Write_Ctrls( CHR( Int_Val ) );
  441.                         END;
  442.                   END
  443.                ELSE IF ( ( Param_Name[1] = 'B' ) AND
  444.                          ( Param_Name[2] IN ['1'..'4'] ) ) THEN
  445.                   Param_Name := ''
  446.                ELSE IF ( Param_Name = 'TT' ) THEN
  447.                   BEGIN
  448.                      IF ( ( Config_Line = 'YM' ) AND ( NOT YM_Seen ) ) THEN
  449.                         Config_Line := 'X1';
  450.                   END
  451.                ELSE IF ( Param_Name = 'TM' ) THEN
  452.                   BEGIN
  453.                      IF ( Config_Line[1] = 'M' ) THEN
  454.                         Config_Line[1] := 'B';
  455.                   END;
  456.  
  457.                IF ( Param_Name <> '' ) THEN
  458.                   BEGIN
  459.                      WRITELN( New_Config_File , Param_Name , '=', Config_Line );
  460.                      Check_Error('Can not write line to new configuration file' );
  461.                   END;
  462.  
  463.             END;
  464.  
  465.    UNTIL ( EOF( Old_Config_File ) );
  466.  
  467.                                    (* Write defaults for new parameters *)
  468.  
  469.    WRITELN( New_Config_File , 'NL=0'   );
  470.    WRITELN( New_Config_File , 'YX=1'   );
  471.    WRITELN( New_Config_File , 'WH=2'   );
  472.    WRITELN( New_Config_File , 'EU=1'   );
  473.    WRITELN( New_Config_File , 'AS=255' );
  474.    WRITELN( New_Config_File , 'EG=1'   );
  475.    WRITELN( New_Config_File , 'ML=0'   );
  476.    WRITELN( New_Config_File , 'V1=0C'  );
  477.    WRITELN( New_Config_File , 'V2=0B'  );
  478.    WRITELN( New_Config_File , 'V3=0C'  );
  479.    WRITELN( New_Config_File , 'V4=0B'  );
  480.    WRITELN( New_Config_File , 'VK='    );
  481.    WRITELN( New_Config_File , 'VN='    );
  482.    WRITELN( New_Config_File , 'KK=0'   );
  483.    WRITELN( New_Config_File , 'ZA=0'   );
  484.  
  485.                                    (* Add Zmodem protocol definition if *)
  486.                                    (* already seen.                     *)
  487.  
  488.    IF ( ( NOT ZM_Seen ) AND ( PD_Count <= 9 ) ) THEN
  489.       WRITELN( New_Config_File , 'Z' , CHR( ORD( '0' ) + PD_Count ),
  490.                '=ZM Zmodem B H RECZMOD.BAT SENDZMOD.BAT' );
  491.  
  492.    WRITELN('Updated configuration file written to ',New_Config_File_Name);
  493.  
  494. END   (* Convert_Config_File *);
  495.  
  496. (*----------------------------------------------------------------------*)
  497.  
  498. BEGIN (* CnfUpDate *)
  499.                                    (* Get file names *)
  500.    Get_File_Names;
  501.                                    (* Open the files *)
  502.    Open_Files;
  503.                                    (* Convert the old file to the new *)
  504.    Convert_Config_File;
  505.                                    (* Close config files *)
  506.    Close_Files;
  507.  
  508. END   (* CnfUpDate *).