home *** CD-ROM | disk | FTP | other *** search
/ Phoenix CD 2.0 / Phoenix_CD.cdr / 15a / murutil.zip / SNAP.PAS < prev    next >
Pascal/Delphi Source File  |  1986-12-28  |  5KB  |  177 lines
  1. PROGRAM SNAP;
  2.  
  3. {  This Turbo Pascal program takes a "snapshot" of the current screen
  4.    display and writes the image to FILENAME.
  5.  
  6.    Note:  This program assumes that the screen image is  a  2000-word
  7.           block starting at Segment $B8000.
  8.  
  9.    Program by Harry M. Murphy,  28 December 1986. }
  10.  
  11. CONST
  12.       FILENAME = 'SNAP.IMG';  {The screen image file name. }
  13.  
  14. TYPE
  15.      DATESTRING = STRING[28];
  16.      TIMESTRING = STRING[6];
  17.      VIDEOBLOCK = ARRAY [1..25,1..80] OF INTEGER;
  18.  
  19. VAR
  20.     DTG    : STRING[40]; { Date/Time string.      }
  21.     FIL    : TEXT[2048]; { The screen image file. }
  22.     I      : 0..25;      { Screen row index.      }
  23.     IMAX   : 0..25;      { Maximum row for image. }
  24.     J      : 0..80;      { Screen column index.   }
  25.     LINE   : STRING[80]; { Working line string.   }
  26.  
  27.     SCREEN : VIDEOBLOCK ABSOLUTE $B800: $0000;   {Video Memory}
  28.  
  29. { ------------------------------- }
  30.  
  31. FUNCTION DATE: DATESTRING;
  32.  
  33. {  This function returns today's date as a DateString of up
  34.    to 28 bytes, such as:  "Tuesday, 18 February 1986".
  35.  
  36.    Note:  TYPE DATESTRING = STRING[28];
  37.  
  38.    Procedure adapted from the Turbo Pascal date example by
  39.    Harry M. Murphy,  18 February 1986.  }
  40.  
  41.   TYPE
  42.        REGPAK = RECORD
  43.                   AX,BX,CX,DX,BP,SI,DI,DS,ES,FL: INTEGER
  44.                 END;
  45.  
  46.   VAR
  47.       ID,IM,IW,IY,JC,JD,JM,JY: INTEGER;
  48.       REG:  REGPAK;
  49.       DAY:  STRING[2];
  50.       DTE:  DATESTRING;
  51.       YEAR: STRING[4];
  52.  
  53.   BEGIN
  54.     WITH REG DO
  55.       BEGIN
  56.         AX := $2A00;
  57.         MSDOS(REG);
  58.         IY := CX;
  59.         IM := HI(DX);
  60.         ID := LO(DX)
  61.       END;
  62.     JY := IY;
  63.     JM := IM-2;
  64.     IF JM < 1
  65.       THEN
  66.         BEGIN
  67.           JM := JM+12;
  68.           JY := JY-1
  69.         END;
  70.     JC := JY DIV 100;
  71.     JD := JY-100*JC;
  72.     IW := ((ID+42+(13*JM-1) DIV 5 +JD+JD DIV 4+JC DIV 4-2*JC) MOD 7);
  73.     CASE IW OF
  74.       0: DTE := 'Sunday, ';
  75.       1: DTE := 'Monday, ';
  76.       2: DTE := 'Tuesday, ';
  77.       3: DTE := 'Wednesday, ';
  78.       4: DTE := 'Thursday, ';
  79.       5: DTE := 'Friday, ';
  80.       6: DTE := 'Saturday, '
  81.     END { CASE };
  82.     STR(ID:2,DAY);
  83.     STR(IY:4,YEAR);
  84.     CASE IM OF
  85.        1: DTE := DTE+DAY+' January '+YEAR;
  86.        2: DTE := DTE+DAY+' February '+YEAR;
  87.        3: DTE := DTE+DAY+' March '+YEAR;
  88.        4: DTE := DTE+DAY+' April '+YEAR;
  89.        5: DTE := DTE+DAY+' May '+YEAR;
  90.        6: DTE := DTE+DAY+' June '+YEAR;
  91.        7: DTE := DTE+DAY+' July '+YEAR;
  92.        8: DTE := DTE+DAY+' August '+YEAR;
  93.        9: DTE := DTE+DAY+' September '+YEAR;
  94.       10: DTE := DTE+DAY+' October '+YEAR;
  95.       11: DTE := DTE+DAY+' November '+YEAR;
  96.       12: DTE := DTE+DAY+' December '+YEAR
  97.     END { CASE };
  98.     DATE := DTE
  99.   END {Function DATE};
  100.  
  101. { ------------------------------- }
  102.  
  103. FUNCTION TIME: TIMESTRING;
  104.  
  105. {  This function returns the current clock time as a TimeString
  106.    of 6 bytes, such as:  "19:05h".
  107.  
  108.    Note:  TYPE TIMESTRING = STRING[6];
  109.  
  110.    Procedure adapted from the Turbo Pascal date example by
  111.    Harry M. Murphy,  19 February 1986.  }
  112.  
  113.   TYPE
  114.        REGPAK = RECORD
  115.                   AX,BX,CX,DX,BP,SI,DI,DS,ES,FL: INTEGER
  116.                 END;
  117.  
  118.   VAR
  119.       H,M,S,T: INTEGER;
  120.       HR:      STRING[2];
  121.       MN:      STRING[2];
  122.       REG:     REGPAK;
  123.  
  124.   BEGIN
  125.     WITH REG DO
  126.       BEGIN
  127.         AX := $2C00;
  128.         MSDOS(REG);
  129.         H := HI(CX);
  130.         M := LO(CX);
  131.         S := HI(DX);
  132.         T := LO(DX)
  133.       END;
  134.     IF T > 50 THEN S := S+1;
  135.     IF S > 30 THEN M := M+1;
  136.     IF M = 60
  137.       THEN
  138.         BEGIN
  139.           H := H+1;
  140.           M := 0;
  141.           IF H = 24 THEN H := 0
  142.         END;
  143.     STR(H:2,HR);
  144.     STR(M:2,MN);
  145.     IF MN[1]=' ' THEN MN[1] := '0';
  146.     TIME := HR+':'+MN+'h'
  147.   END {Function TIME};
  148.  
  149. { ------------------------------- }
  150.  
  151. BEGIN {Program SNAP}
  152.   DTG := TIME+', '+DATE+'.';
  153.   ASSIGN(FIL,FILENAME);
  154.   REWRITE(FIL);
  155.   IMAX := WHEREY-2;
  156.   GOTOXY(1,IMAX+1);
  157.   IF IMAX < 14 THEN IMAX := 25;
  158.   FOR I := 1 TO IMAX DO
  159.     BEGIN
  160.       FOR J := 1 TO 80 DO LINE[J] := CHR(LO(SCREEN[I,J]));
  161.       LINE[0] := CHR(0);
  162.       J := 80;
  163.       WHILE LINE[J] = ' ' DO J := J-1;
  164.       LINE[0] := CHR(J);
  165.       IF J = 0
  166.         THEN
  167.           WRITELN(FIL)
  168.         ELSE
  169.           WRITELN(FIL,LINE)
  170.     END;
  171.   WRITELN(FIL,'>>>>>>>>>>  Screen snapshot taken:  ',DTG);
  172.   CLOSE(FIL);
  173.   LOWVIDEO;
  174.   CLREOL;
  175.   WRITELN('>>>>>>>>>>  Screen snapshot written to ',FILENAME)
  176. END.
  177.