home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / NUTUG11.ZIP / DTSTAMP.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-11-21  |  11.7 KB  |  445 lines
  1.  
  2. PROGRAM DTSTAMP;
  3.  
  4.          {This routine is for changing the date/time stamp on a disk
  5.           file.  It is a useful supplement to the Norton's Utilities.
  6.           These routines can also be used for adding the date and time
  7.           to directory listings.  JEH 10/8/86. }
  8.  
  9. Uses      Dos,
  10.           Crt;
  11. TYPE
  12.  
  13.   String20 = string[20];
  14.   String80 = string[80];
  15.  
  16.   Register = Registers;
  17.  
  18. PROCEDURE Chirp;                       {A pleasantly soft audio signal.     }
  19.  
  20. Begin
  21.  
  22.   sound(2000);
  23.   delay(8);
  24.   nosound;
  25.  
  26. End; {Chirp}
  27.  
  28. PROCEDURE TrimLine (Var StrT :  String);
  29.  
  30.          {Deletes leading and trailing spaces from input StrT.              }
  31.  
  32. Begin
  33.  
  34.   if Length (StrT) = 0 then
  35.     Exit;
  36.  
  37.   while (StrT[ length (StrT) ] = #32) and (length (StrT) > 0) do
  38.     StrT[0] := pred (StrT[0]);         {Eliminate trailing blanks,          }
  39.  
  40.   while (StrT[1] = #32) and (length (StrT) > 0) do
  41.     delete (StrT, 1, 1);
  42.  
  43. End; {TrimLine}
  44.  
  45.  
  46. FUNCTION HashDate (Date : String) : integer;
  47.  
  48.          {This takes as input a string in the form mm-dd-yy and hashes
  49.           it to the code required by the DOS service call $57. It
  50.           returns - 1 if the date is unacceptable. }
  51.  
  52.          {Hashed Date = (Year - 1980) * 512 + Month * 32 + Day}
  53.  
  54. VAR
  55.  
  56.   C, K  : integer;
  57.   HoldS : String20;
  58.   Code  : integer;
  59.   D, M, Y : integer;
  60.  
  61. Begin
  62.  
  63.   HashDate := - 1;                     {Default return.                     }
  64.   K := Pos ('-', Date);
  65.   if K = 0 then
  66.     Exit;                              {Bad format.                         }
  67.  
  68.   HoldS := copy (Date, 1, K - 1);      {Get month.                          }
  69.   Val (HoldS, M, C);
  70.   IF C = 0 THEN
  71.     IF Abs(M) > MaxInt THEN Exit;(* Version 4.0 can overflow on      *)
  72.                                        (* integers                         *)
  73.  
  74.   if C <> 0 then
  75.     Exit;
  76.   if not (M in [1..12]) then
  77.     Exit;
  78.   Delete (Date, 1, K);
  79.  
  80.   K := Pos ('-', Date);                {Get day.                            }
  81.   if K = 0 then
  82.     Exit;
  83.   HoldS := copy (Date, 1, K - 1);
  84.   Val (HoldS, D, C);
  85.   IF C = 0 THEN
  86.     IF Abs(D) > MaxInt THEN Exit;(* Version 4.0 can overflow on      *)
  87.                                        (* integers                         *)
  88.   if C <> 0 then
  89.     Exit;
  90.   if not (D in [1..31]) then
  91.     Exit;
  92.   Delete (Date, 1, K);
  93.  
  94.   Val (Date, Y, C);                    {Get year.                           }
  95.   IF C = 0 THEN
  96.     IF Abs(Y) > MaxInt THEN Exit;(* Version 4.0 can overflow on      *)
  97.                                        (* integers                         *)
  98.   if C <> 0 then
  99.     Exit;
  100.   if not (Y in [80..100]) then
  101.     Exit;
  102.  
  103.   Y := Y - 80;
  104.  
  105.   HashDate := 512 * Y + 32 * M + D;
  106.  
  107. End; {HashDate (Date : String) : integer}
  108.  
  109. FUNCTION UnHashDate (DOSDate : integer) : String;
  110.  
  111.          {Converts hashed DOS date Date to a string dd-mm-yy. }
  112. VAR
  113.  
  114.   J, K       : integer;
  115.   DS, MS, YS : string[5];
  116.   D, M, Y    : integer;
  117.   R          : real;
  118.  
  119. Begin
  120.  
  121.   R := 1.0 * DOSDate;
  122.   if R < 0 then
  123.     R := R + 65536.0;
  124.   Y := Trunc (R / 512.0);
  125.   R := R - Y * 512.0;
  126.   M := Trunc (R / 32.0);
  127.   D := Trunc (R - (M * 32.0));
  128.  
  129.   Y    := Y + 80;
  130.   Str (Y, YS);
  131.   Str (M:2, MS);
  132.   Str (D, DS);
  133.  
  134.   while length (DS) < 2 do
  135.     DS := '0' + DS;
  136.  
  137.   UnHashDate := MS + '-' + DS + '-' + YS;
  138.  
  139. End; {UnHashDate (DOSDate : integer) : String}
  140.  
  141. FUNCTION HashTime (Time : String) : integer;
  142.  
  143.          {Hashes input Time in the form of hr.min or hr:min to integer
  144.          required by DOS. Returns - 1 if input not acceptable. }
  145.          {Hashed time = Hour * 2048 + Min * 32.  }
  146. VAR
  147.  
  148.   C, K  : integer;
  149.   H, M  : integer;
  150.   HoldS : String20;
  151.  
  152. Begin
  153.  
  154.   HashTime := - 1;                     {Default return.                     }
  155.   TrimLine (Time);
  156.   K := Pos ('.', Time);
  157.   if K = 0 then                        {Check for both terminators.         }
  158.     K := Pos (':', Time);
  159.   if K = 0 then
  160.     Exit;                              {Improper format.                    }
  161.   HoldS := Copy (Time, 1, K - 1);
  162.   Val (HoldS, H, C);
  163.     IF C = 0 THEN
  164.     IF Abs(H) > MaxInt THEN Exit;(* Version 4.0 can overflow on      *)
  165.                                        (* integers                         *)
  166. if C <> 0 then
  167.     Exit;
  168.   if not (H in [0..23]) then
  169.     Exit;
  170.   Delete (Time, 1, K);
  171.   Val (Time, M, C);
  172.     IF C = 0 THEN
  173.     IF Abs(M) > MaxInt THEN Exit;(* Version 4.0 can overflow on      *)
  174.                                        (* integers                         *)
  175. if C <> 0 then
  176.     Exit;
  177.   if not (M in [0..59]) then
  178.     Exit;
  179.  
  180.   HashTime := 2048 * H + 32 * M;
  181.  
  182. End; {HashTime (Time : String) : integer}
  183.  
  184. FUNCTION UnHashTime (DOSTime : integer; VAR APTime : String) : String;
  185.  
  186.          {Converts hashed DOSTime to string hr(24):min. APTime also
  187.           returns the time in the am/pm format used in the DOS directory
  188.           listing. }
  189. VAR
  190.  
  191.   H, M, HAP : integer;
  192.   HS, MS    : string[10];
  193.   J, K      : integer;
  194.   R         : real;
  195.  
  196. Begin
  197.  
  198.   R := 1.0 * DOSTime;                  {Real necessary because DOSTime can  }
  199.   if R < 0 then                        {be < 0.                             }
  200.     R := R + 65536.0;
  201.   H := Trunc (R / 2048.0);
  202.   R := R - (H * 2048.0);
  203.   M := Trunc (R / 32.0);
  204.  
  205.   Str (H:2, HS);
  206.   Str (M, MS);
  207.   while length (MS) < 2 do
  208.     MS := '0' + MS;
  209.  
  210.   UnHashTime := HS + ':' + MS;
  211.  
  212.   HAP := H Mod 12;                     {Format am/pm time.                  }
  213.   if HAP = 0 then
  214.     HAP := 12;
  215.   Str (HAP:2, HS);
  216.   APTime := HS + ':' + MS;
  217.   if H > 11
  218.     then
  219.       APTime := APTime + 'p'
  220.     else
  221.       APTime := APTime + 'a';
  222.  
  223. End; {UnHashTime (DOSTime : integer) : String}
  224.  
  225.  
  226. FUNCTION GetFileHandle (PathFileName : String) : integer;
  227.  
  228.          {Opens file 'PathFileName' and returns with the File Handle
  229.           number. Returns - 1 if unable to open file. }
  230.  
  231. VAR
  232.  
  233.   Reg         : Register;
  234.   DOSFileName : String;
  235.   Handle      : integer;
  236.  
  237. Begin
  238.  
  239.   GetFileHandle := - 1;                {Default return.                     }
  240.   DOSFileName := PathFileName + #0;    {Create ASCIIZ string.               }
  241.   with Reg do                          {Open DOS File.                      }
  242.     begin
  243.       AH := $3D;                       {DOS service for opening file.       }
  244.       AL := $0;                        {Access code.                        }
  245.       DS := Seg (DOSFileName[1]);
  246.       DX := Ofs (DOSFileName[1]);
  247.       MsDos (Reg);
  248.       if (Flags and 1) = 1 then        {Unable to open file.                }
  249.         Exit;
  250.       GetFileHandle := Reg.AX;
  251.    end; {with}
  252.  
  253. End; {GetFileHandle (PathFileName : String) : integer}
  254.  
  255. FUNCTION ReleaseFileHandle (Handle : integer) : integer;
  256.  
  257.          {Closes file. Returns zero if OK or - 1 if error.}
  258. VAR
  259.  
  260.   Reg : Register;
  261.  
  262. Begin
  263.  
  264.   ReleaseFileHandle := - 1;            {Default return.                     }
  265.   with Reg do
  266.     begin
  267.       AH := $3E;                       {DOS service for closing file handle.}
  268.       BX := Handle;                    {File handle.                        }
  269.       MsDos (Reg);
  270.       if (Flags and 1) = 1 then
  271.         Exit;                          {Error return.                       }
  272.     end; {with}
  273.  
  274.   ReleaseFileHandle := 0;
  275.  
  276. End; {ReleaseFileHandle (Handle : integer) : integer}
  277.  
  278. FUNCTION GetDOSFileDateTime
  279.              (Handle : integer; VAR DOSDate, DOSTime : integer) : integer;
  280.  
  281.          {Gets Date and Time hashed variables for a previously opened
  282.           file. Returns 0 if OK and - 1 for an error. }
  283. VAR
  284.  
  285.   Reg : Register;
  286.  
  287. Begin
  288.  
  289.   GetDOSFileDateTime := - 1;           {Default return.                     }
  290.   with Reg do
  291.     begin                              {Get File date and time.             }
  292.       AH := $57;                       {DOS Date/Time service.              }
  293.       AL := $00;                       {Select Get.                         }
  294.       BX := Handle;
  295.       MsDos (Reg);
  296.       if (Flags and 1) = 1 then
  297.         Exit;
  298.       DOSTime := CX;
  299.       DOSDate := DX;
  300.    end; {with}
  301.  
  302.   GetDOSFileDateTime := 0;
  303.  
  304. End; {GetDOSFileDateTime
  305.             (Handle : integer; VAR DOSDate, DOSTime : integer) : integer}
  306.  
  307. FUNCTION SetDOSFileDateTime (Handle, DOSDate, DOSTime : integer) : integer;
  308.  
  309.          {Sets Date and Time for a previously opened file. Returns
  310.           0 if OK and - 1 for an error. }
  311. VAR
  312.  
  313.   Reg : Register;
  314.  
  315. Begin
  316.  
  317.   SetDOSFileDateTime := - 1;           {Default return.                     }
  318.   with Reg do
  319.     begin                              {Set File date and time.             }
  320.       AH := $57;
  321.       AL := $01;                       {Select Set.                         }
  322.       BX := Handle;
  323.       CX := DOSTime;
  324.       DX := DOSDate;
  325.       MsDos (Reg);
  326.       if (Flags and 1) = 1 then
  327.         Exit;
  328.    end; {with}
  329.  
  330.    SetDOSFileDateTime := 0;
  331.  
  332. End; {SetDOSFileDateTime (Handle, DOSDate, DOSTime : integer) : integer}
  333.  
  334. PROCEDURE Menu;
  335.  
  336. CONST
  337.  
  338.   L1 = ' ROUTINE FOR CHANGING DATE AND TIME STAMP OF DISK FILES ';
  339.   T  = 8;                              {First line of menu.                 }
  340.  
  341. VAR
  342.  
  343.   FileName : String;
  344.   K        : integer;
  345.   Handle   : integer;
  346.   DOSDate  : integer;
  347.   DOSTime  : integer;
  348.   Date     : String;
  349.   Time     : String;
  350.   APTime   : String;
  351.   ch       : char;
  352.  
  353. Begin
  354.  
  355.   repeat {1}
  356.     LowVideo;
  357.     ClrScr;
  358.     GoToXY (12, 5);
  359.     NormVideo; Write (L1);
  360.     GoToXY (57, 22);
  361.     write (' JEH 10/86 ');
  362.     LowVideo;
  363.  
  364.     repeat {2}
  365.       GoToXY (5, T); ClrEol;
  366.       write ('Enter Path/File Name (0 to Exit): ');
  367.       NormVideo; read (FileName); LowVideo;
  368.       TrimLine (FileName);
  369.       if FileName = '0' then
  370.         Exit;
  371.       for K := 1 to Length (FileName) do
  372.         FileName[K] := UpCase (FileName[K]);
  373.       Handle := GetFileHandle (FileName);
  374.       if Handle < 0 then
  375.         begin
  376.           Chirp;
  377.           GoToXY (5, T + 2);
  378.           write ('Unable to find ' + FileName + '. Please try again.');
  379.         end;
  380.     until Handle > 0; {Repeat (2)}
  381.  
  382.     K    := GetDOSFileDateTime (Handle, DOSDate, DOSTime);
  383.     Date := UnHashDate (DOSDate);
  384.     Time := UnHashTime (DOSTime, APTime);
  385.     GoToXY (5, T + 2); ClrEOL;
  386.     write
  387.        ('Present date and time for ' + FileName + ': ' + Date + '  ' + Time);
  388.  
  389.     repeat {3}
  390.       GoToXY (5, T + 4); ClrEol;
  391.       write ('      Enter new date [mm-dd-yy]: ');
  392.       NormVideo; readln (Date); LowVideo;
  393.       TrimLine (Date);
  394.       DOSDate := HashDate (Date);
  395.       if DOSDate = - 1 then
  396.         begin
  397.           Chirp;
  398.           GoToXY (5, T + 6);
  399.           write (Date + ' is an invalid date. Please re-enter');
  400.         end;
  401.     until DOSDate <> - 1; {Repeat (3)}
  402.  
  403.     repeat {4}
  404.       GoToXY (5, T + 6); ClrEol;
  405.       write ('      Enter new time [hr(24) : min]: ');
  406.       NormVideo; readln(Time); LowVideo;
  407.       TrimLine (Time);
  408.       DOSTime := HashTime (Time);
  409.       if DOSTime = - 1 then
  410.         begin
  411.           Chirp;
  412.           GoToXY (5, T + 8);
  413.           write (Time + ' is an invalid time. Please re-enter');
  414.         end;
  415.     until DOSTime <> - 1; {Repeat (4)}
  416.  
  417.     K := SetDOSFileDateTime (Handle, DOSDate, DOSTime);
  418.     GoToXY (5, T + 8); ClrEol;
  419.     if K >= 0
  420.       then
  421.         begin
  422.           K    := GetDOSFileDateTime (Handle, DOSDate, DOSTime);
  423.           Date := UnHashDate (DOSDate);
  424.           Time := UnHashTime (DOSTime, APTime);
  425.           write ('Directory Date/Time entry for '
  426.                    + FileName + ' now reads: ' + Date + '  ' + APTime);
  427.         end
  428.       else
  429.         write ('Updating of ' + FileName + ' failed.');
  430.     K := ReleaseFileHandle (Handle);
  431.     GoToXY (5, T + 10); ClrEol;
  432.     write ('Press 0 to exit or any other key to continue. ');
  433.     ch := ReadKey;
  434.  
  435.   until ch = '0'; {Repeat (1)}
  436.  
  437. End; {Menu}
  438.  
  439. BEGIN
  440.  
  441.   Menu;
  442.   ClrScr;
  443.  
  444. END.
  445.