Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/TPSCRNSV.ZIP/SCRNCOMM.PAS

Pascal/Delphi Source File | 1990-04-01 | 6.1 KB | 187 lines

{$A-,B-,D+,E-,F-,I+,L+,N-,O-,R+,S+,V+}
{$M 5000,0,0}

PROGRAM SCSVCOMM;

   Uses CRT,DOS;

   CONST TSR_Signature:String='The SCRNSAVE - Memory-resident Program by Ilya Shlyakhter';

   TYPE Address=RECORD
                  CASE Boolean OF
                    True:(Offset,Segment:Word);
                    False:(Ptr:Pointer)
                END;

{ *****************************DupCheck*********************************** }

  FUNCTION DupCheck:Byte;

    CONST Dif=451;
          Signature_Offset=28;

    VAR Vec:Word;
        IntrAddress:Address;
        Current_Signature:String;
        Length_of_TSR_Signature:Byte Absolute TSR_Signature;

        Done:Boolean;

    BEGIN {DupCheck}
      Vec:=$60;
      Done:=False;

      WHILE (Vec<$68) And Not Done DO
        BEGIN
          GetIntVec(Vec,IntrAddress.Ptr);
          IF IntrAddress.Ptr=Nil THEN
            BEGIN {If TSR has not yet been installed...}
              DupCheck:=0;
              Done:=True
            END
              ELSE {If TSR may have been installed...}
                BEGIN
                  Move(Mem[IntrAddress.Segment+Dif:Signature_Offset],
                                  Current_Signature,Length_of_TSR_Signature+1);
                  IF Current_Signature=TSR_Signature THEN
                    BEGIN
                      DupCheck:=Vec;
                      Done:=True
                    END
                      ELSE Inc(Vec)
                END {of If TSR may have been installed...}
        END; {of While...}

        IF Not Done THEN
           DupCheck:=0;

      END; {of DupCheck}

{ **************************Variables used by TSR************************* }

   VAR TSR_Int:Byte;
       TSR_AX:Word;
       TSR_BX:Word;

       Suspended:Boolean;
       Done:Boolean;
       Ch:Char;

       Regs:Registers;
       Parameter:String[9];
       Length_of_Parameter:Byte Absolute Parameter;
       I:Byte;
       Code:Word;
       New_Time_Limit:Real;

{ **************************Outer block of the TSR*********************** }

  BEGIN
    TSR_Int:=DupCheck;

    IF TSR_Int>0 THEN
      BEGIN
        FillChar(Regs,SizeOf(Regs),0);
        IF ParamCount>0 THEN
          BEGIN
            Parameter:=ParamStr(1);
            FOR I:=1 TO Length_of_Parameter DO
              Parameter[I]:=UpCase(Parameter[I]);

            WITH Regs DO
              IF Parameter='STOP' THEN AX:=1
                ELSE
                  IF Parameter='HOLD' THEN AX:=2
                    ELSE
                      IF Parameter='RESTART' THEN AX:=3
                        ELSE
                          IF Parameter='TIMELIMIT' THEN
                            BEGIN
                              Val(ParamStr(2),New_Time_Limit,Code);
                              IF (Code=0) And (New_Time_Limit>0) And
                                  (New_Time_Limit<11) THEN
                                  BEGIN {Install new time limit}
                                    FillChar(Regs,SizeOf(Regs),0);
                                    Regs.AX:=8;
                                    Regs.BX:=Trunc(New_Time_Limit*18.2*60)
                                  END
                                    ELSE
                                      Writeln('Invalid time limit: ',ParamStr(2))
                            END
                         ELSE AX:=15;

            IF Regs.AX<15 THEN
              Intr(TSR_Int,Regs)
                ELSE
                  BEGIN
                    Writeln;
                    Write('SCSVCOMM: Invalid parameter ',Parameter);
                  END
          END
        ELSE
          BEGIN

            FillChar(Regs,SizeOf(Regs),0);
            Regs.AX:=5; {Get status of resident SCRNSAVE}
            Intr(TSR_Int,Regs);
            Suspended:=(Regs.AX=5);
            FillChar(Regs,SizeOf(Regs),0);

            Write('Current  SCRNSAVE status: ');
            IF Suspended THEN
                Writeln('Active')
              ELSE
                Writeln('Suspended');
            Writeln;
            Write('Unload, ');
            IF Suspended THEN
              Write('Restart, ')
                ELSE
                  Write('Suspend, ');

            Writeln('Change time limit? ');
            Done:=True;

            REPEAT
              Ch:=ReadKey;
              IF Ch=#0 THEN
                BEGIN
                  Ch:=ReadKey;
                  Done:=False
                END
                  ELSE
                    BEGIN
                      Ch:=UpCase(Ch);
                      IF Ch='U' THEN BEGIN Regs.AX:=1;Intr(TSR_Int,Regs) END
                        ELSE IF Suspended And (Ch='R') THEN BEGIN Regs.AX:=3;Intr(TSR_Int,Regs) END ELSE
                             IF Not Suspended And (Ch='S') THEN BEGIN Regs.AX:=2;Intr(TSR_Int,Regs) END ELSE
                              IF Ch='C' THEN
                               BEGIN
                                 Write('New time limit: ');
                                 Readln(Parameter);
                                 Val(Parameter,New_Time_Limit,Code);

                                 IF (Code=0) And (New_Time_Limit>0) And
                                     (New_Time_Limit<11) THEN
                                     BEGIN {Install new time limit}
                                       FillChar(Regs,SizeOf(Regs),0);
                                       Regs.AX:=8;
                                       Regs.BX:=Trunc(New_Time_Limit*18.2*60);
                                       Intr(TSR_Int,Regs)
                                     END
                                       ELSE
                                         Writeln('Invalid time limit: ',Parameter)

                               END  ELSE Done:=False
                    END;
              UNTIL Done;
          END {of prompting the user that no params have been given}
       END
            ELSE {If TSR has not been installed yet...}
              BEGIN
                Writeln;
                Writeln('SCSVCOMM: Screen Saver not installed yet.');
                Writeln
              END
 END.