PageRenderTime 52ms CodeModel.GetById 44ms app.highlight 3ms RepoModel.GetById 1ms app.codeStats 0ms

/packages/fv/src/time.pas

https://github.com/slibre/freepascal
Pascal | 480 lines | 199 code | 42 blank | 239 comment | 0 complexity | 179a1a7b7a70f97587a74de6062eece4 MD5 | raw file
Possible License(s): LGPL-2.0, LGPL-2.1, LGPL-3.0
  1{*********************[ TIME UNIT ]************************}
  2{                                                          }
  3{             System independent TIME unit                 }
  4{                                                          }
  5{   Copyright (c) 1996, 1997, 1998, 1999 by Leon de Boer   }
  6{   ldeboer@attglobal.net  - primary e-mail address        }
  7{   ldeboer@starwon.com.au - backup e-mail address         }
  8{                                                          }
  9{****************[ THIS CODE IS FREEWARE ]*****************}
 10{                                                          }
 11{     This sourcecode is released for the purpose to       }
 12{   promote the pascal language on all platforms. You may  }
 13{   redistribute it and/or modify with the following       }
 14{   DISCLAIMER.                                            }
 15{                                                          }
 16{     This SOURCE CODE is distributed "AS IS" WITHOUT      }
 17{   WARRANTIES AS TO PERFORMANCE OF MERCHANTABILITY OR     }
 18{   ANY OTHER WARRANTIES WHETHER EXPRESSED OR IMPLIED.     }
 19{                                                          }
 20{*****************[ SUPPORTED PLATFORMS ]******************}
 21{     16 and 32 Bit compilers                              }
 22{        DOS      - Turbo Pascal 7.0 +      (16 Bit)       }
 23{        DPMI     - Turbo Pascal 7.0 +      (16 Bit)       }
 24{                 - FPC 0.9912+ (GO32V2)    (32 Bit)       }
 25{        WINDOWS  - Turbo Pascal 7.0 +      (16 Bit)       }
 26{                 - Delphi 1.0+             (16 Bit)       }
 27{        WIN95/NT - Delphi 2.0+             (32 Bit)       }
 28{                 - Virtual Pascal 2.0+     (32 Bit)       }
 29{                 - Speedsoft Sybil 2.0+    (32 Bit)       }
 30{                 - FPC 0.9912+             (32 Bit)       }
 31{        OS2      - Virtual Pascal 1.0+     (32 Bit)       }
 32{                 - Speed Pascal 1.0+       (32 Bit)       }
 33{                 - C'T patch to BP         (16 Bit)       }
 34{                                                          }
 35{******************[ REVISION HISTORY ]********************}
 36{  Version  Date        Fix                                }
 37{  -------  ---------   ---------------------------------  }
 38{  1.00     06 Dec 96   First multi platform release.      }
 39{  1.10     06 Jul 97   New functiions added.              }
 40{  1.20     22 Jul 97   FPC pascal compiler added.         }
 41{  1.30     29 Aug 97   Platform.inc sort added.           }
 42{  1.40     13 Oct 97   Delphi 2/3 32 bit code added.      }
 43{  1.50     06 Nov 97   Speed pascal code added.           }
 44{  1.60     05 May 98   Virtual pascal 2.0 compiler added. }
 45{  1.61     07 Jul 99   Speedsoft SYBIL 2.0 code added.    }
 46{**********************************************************}
 47
 48UNIT Time;
 49
 50{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
 51                                  INTERFACE
 52{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
 53
 54{====Include file to sort compiler platform out =====================}
 55{$I platform.inc}
 56{====================================================================}
 57
 58{==== Compiler directives ===========================================}
 59
 60{$IFNDEF PPC_FPC} { FPC doesn't support these switches }
 61   {$F-} { Short calls are okay }
 62   {$A+} { Word Align Data }
 63   {$B-} { Allow short circuit boolean evaluations }
 64   {$O+} { This unit may be overlaid }
 65   {$G+} { 286 Code optimization - if you're on an 8088 get a real computer }
 66   {$E+} {  Emulation is on }
 67   {$N-} {  No 80x87 code generation }
 68{$ENDIF}
 69
 70{$X+} { Extended syntax is ok }
 71{$R-} { Disable range checking }
 72{$S-} { Disable Stack Checking }
 73{$I-} { Disable IO Checking }
 74{$Q-} { Disable Overflow Checking }
 75{$V-} { Turn off strict VAR strings }
 76{====================================================================}
 77
 78{***************************************************************************}
 79{                            INTERFACE ROUTINES                             }
 80{***************************************************************************}
 81
 82{-CurrentMinuteOfDay-------------------------------------------------
 83Returns the number of minutes since midnight of a current system time.
 8419Jun97 LdB               (Range: 0 - 1439)
 85---------------------------------------------------------------------}
 86FUNCTION CurrentMinuteOfDay: Word;
 87
 88{-CurrentSecondOfDay-------------------------------------------------
 89Returns the number of seconds since midnight of current system time.
 9024Jun97 LdB               (Range: 0 - 86399)
 91---------------------------------------------------------------------}
 92FUNCTION CurrentSecondOfDay: LongInt;
 93
 94{-CurrentSec100OfDay-------------------------------------------------
 95Returns the 1/100ths of a second since midnight of current system time.
 9624Jun97 LdB               (Range: 0 - 8639999)
 97---------------------------------------------------------------------}
 98FUNCTION CurrentSec100OfDay: LongInt;
 99
100{-MinuteOfDay--------------------------------------------------------
101Returns the number of minutes since midnight of a valid given time.
10219Jun97 LdB               (Range: 0 - 1439)
103---------------------------------------------------------------------}
104FUNCTION MinuteOfDay (Hour24, Minute: Word): Word;
105
106{-SecondOfDay--------------------------------------------------------
107Returns the number of seconds since midnight of a valid given time.
10819Jun97 LdB               (Range: 0 - 86399)
109---------------------------------------------------------------------}
110FUNCTION SecondOfDay (Hour24, Minute, Second: Word): LongInt;
111
112{-SetTime------------------------------------------------------------
113Set the operating systems time clock to the given values. If values
114are invalid this function will fail without notification.
11506Nov97 LdB
116---------------------------------------------------------------------}
117PROCEDURE SetTime (Hour, Minute, Second, Sec100: Word);
118
119{-GetTime------------------------------------------------------------
120Returns the current time settings of the operating system.
12106Nov97 LdB
122---------------------------------------------------------------------}
123PROCEDURE GetTime (Var Hour, Minute, Second, Sec100: Word);
124
125{-MinutesToTime------------------------------------------------------
126Returns the time in hours and minutes of a given number of minutes.
12719Jun97 LdB
128---------------------------------------------------------------------}
129PROCEDURE MinutesToTime (Md: LongInt; Var Hour24, Minute: Word);
130
131{-SecondsToTime------------------------------------------------------
132Returns the time in hours, mins and secs of a given number of seconds.
13319Jun97 LdB
134---------------------------------------------------------------------}
135PROCEDURE SecondsToTime (Sd: LongInt; Var Hour24, Minute, Second: Word);
136
137{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
138                                IMPLEMENTATION
139{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
140{$IFDEF OS_WINDOWS}                                   { WIN/NT CODE }
141
142  {$IFNDEF PPC_SPEED}                                 { NON SPEED COMPILER }
143    {$IFDEF PPC_FPC}                                  { FPC WINDOWS COMPILER }
144    USEs Windows;                                     { Standard unit }
145    {$ELSE}                                           { OTHER COMPILERS }
146    USES WinTypes, WinProcs;                          { Standard units }
147    {$ENDIF}
148  {$ELSE}                                             { SPEEDSOFT COMPILER }
149  USES WinBase;                                       { Standard unit }
150  TYPE TSystemTime = SystemTime;                      { Type fix up }
151  {$ENDIF}
152
153{$ENDIF}
154
155{$IFDEF OS_OS2}                                       { OS2 COMPILERS }
156
157  {$IFDEF PPC_VIRTUAL}                                { VIRTUAL PASCAL }
158  USES OS2Base;                                       { Standard unit }
159  {$ENDIF}
160
161  {$IFDEF PPC_SPEED}                                  { SPEED PASCAL }
162  USES BseDos, Os2Def;                                { Standard unit }
163  {$ENDIF}
164
165  {$IFDEF PPC_FPC}                                    { FPC }
166  USES Dos, DosCalls;                                 { Standard unit }
167
168  TYPE DateTime = TDateTime;                          { Type correction }
169  {$ENDIF}
170
171  {$IFDEF PPC_BPOS2}                                  { C'T PATCH TO BP CODE }
172  USES DosTypes, DosProcs;                            { Standard unit }
173
174  TYPE DateTime = TDateTime;                          { Type correction }
175  {$ENDIF}
176
177{$ENDIF}
178
179{$ifdef OS_UNIX}
180  USES Dos;
181{$endif OS_UNIX}
182
183{$ifdef OS_GO32}
184  USES Dos;
185{$endif OS_GO32}
186
187{$ifdef OS_NETWARE}
188  USES Dos;
189{$endif OS_NETWARE}
190
191{$ifdef OS_AMIGA}
192  USES Dos;
193{$endif OS_AMIGA}
194
195{***************************************************************************}
196{                            INTERFACE ROUTINES                             }
197{***************************************************************************}
198
199{---------------------------------------------------------------------------}
200{  CurrentMinuteOfDay -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 24Jun97 LdB}
201{---------------------------------------------------------------------------}
202FUNCTION CurrentMinuteOfDay: Word;
203VAR Hour, Minute, Second, Sec100: Word;
204BEGIN
205   GetTime(Hour, Minute, Second, Sec100);             { Get current time }
206   CurrentMinuteOfDay := (Hour * 60) + Minute;        { Minute from midnight }
207END;
208
209{---------------------------------------------------------------------------}
210{  CurrentSecondOfDay -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 24Jun97 LdB}
211{---------------------------------------------------------------------------}
212FUNCTION CurrentSecondOfDay: LongInt;
213VAR Hour, Minute, Second, Sec100: Word;
214BEGIN
215   GetTime(Hour, Minute, Second, Sec100);             { Get current time }
216   CurrentSecondOfDay := (LongInt(Hour) * 3600) +
217     (Minute * 60) + Second;                          { Second from midnight }
218END;
219
220{---------------------------------------------------------------------------}
221{  CurrentSec100OfDay -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 24Jun97 LdB}
222{---------------------------------------------------------------------------}
223FUNCTION CurrentSec100OfDay: LongInt;
224VAR Hour, Minute, Second, Sec100: Word;
225BEGIN
226   GetTime(Hour, Minute, Second, Sec100);             { Get current time }
227   CurrentSec100OfDay := (LongInt(Hour) * 360000) +
228     (LongInt(Minute) * 6000) + (Second*100)+ Sec100; { Sec100 from midnight }
229END;
230
231{---------------------------------------------------------------------------}
232{  MinuteOfDay -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 19Jun97 LdB       }
233{---------------------------------------------------------------------------}
234FUNCTION MinuteOfDay (Hour24, Minute: Word): Word;
235BEGIN
236   MinuteOfDay := (Hour24 * 60) + Minute;             { Minute from midnight }
237END;
238
239{---------------------------------------------------------------------------}
240{  SecondOfDay -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 19Jun97 LdB       }
241{---------------------------------------------------------------------------}
242FUNCTION SecondOfDay (Hour24, Minute, Second: Word): LongInt;
243BEGIN
244   SecondOfDay := (LongInt(Hour24) * 3600) +
245     (Minute * 60) + Second;                          { Second from midnight }
246END;
247
248{---------------------------------------------------------------------------}
249{  SetTime -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Nov97 LdB           }
250{---------------------------------------------------------------------------}
251PROCEDURE SetTime (Hour, Minute, Second, Sec100: Word);
252{$IFDEF OS_DOS}                                       { DOS/DPMI CODE }
253   {$IFDEF ASM_BP}                                    { BP COMPATABLE ASM }
254   ASSEMBLER;
255   ASM
256     MOV CH, BYTE PTR Hour;                           { Fetch hour }
257     MOV CL, BYTE PTR Minute;                         { Fetch minute }
258     MOV DH, BYTE PTR Second;                         { Fetch second }
259     MOV DL, BYTE PTR Sec100;                         { Fetch hundredths }
260     MOV AX, $2D00;                                   { Set function id }
261     PUSH BP;                                         { Safety save register }
262     INT $21;                                         { Set the time }
263     POP BP;                                          { Restore register }
264   END;
265   {$ENDIF}
266   {$IFDEF ASM_FPC}                                   { FPC COMPATABLE ASM }
267   BEGIN
268   ASM
269     MOVB Hour, %CH;                                  { Fetch hour }
270     MOVB Minute, %CL;                                { Fetch minute }
271     MOVB Second, %DH;                                { Fetch second }
272     MOVB Sec100, %DL;                                { Fetch hundredths }
273     MOVW $0x2D00, %AX;                               { Set function id }
274     PUSHL %EBP;                                      { Save register }
275     INT $0x21;                                       { BIOS set time }
276     POPL %EBP;                                       { Restore register }
277   END;
278   END;
279   {$ENDIF}
280{$ENDIF}
281{$IFDEF OS_WINDOWS}                                   { WIN/NT CODE }
282   {$IFDEF BIT_16}                                    { 16 BIT WINDOWS CODE }
283   ASSEMBLER;
284   ASM
285     MOV CH, BYTE PTR Hour;                           { Fetch hour }
286     MOV CL, BYTE PTR Minute;                         { Fetch minute }
287     MOV DH, BYTE PTR Second;                         { Fetch second }
288     MOV DL, BYTE PTR Sec100;                         { Fetch hundredths }
289     MOV AX, $2D00;                                   { Set function id }
290     PUSH BP;                                         { Safety save register }
291     INT $21;                                         { Set the time }
292     POP BP;                                          { Restore register }
293   END;
294   {$ENDIF}
295   {$IFDEF BIT_32_OR_MORE}                            { 32 BIT WINDOWS CODE }
296   VAR DT: TSystemTime;
297   BEGIN
298     {$IFDEF PPC_FPC}                                 { FPC WINDOWS COMPILER }
299     GetLocalTime(@DT);                               { Get the date/time }
300     {$ELSE}                                          { OTHER COMPILERS }
301     GetLocalTime(DT);                                { Get the date/time }
302     {$ENDIF}
303     DT.wHour := Hour;                                { Transfer hour }
304     DT.wMinute := Minute;                            { Transfer minute }
305     DT.wSecond := Second;                            { Transfer seconds }
306     DT.wMilliseconds := Sec100 * 10;                 { Transfer millisecs }
307     SetLocalTime(DT);                               { Set the date/time }
308   END;
309   {$ENDIF}
310{$ENDIF}
311{$IFDEF OS_OS2}                                       { OS2 CODE }
312VAR DT: DateTime;
313BEGIN
314   DosGetDateTime(DT);                                { Get the date/time }
315   DT.Hours := Hour;                                  { Transfer hour }
316   DT.Minutes := Minute;                              { Transfer minute }
317   DT.Seconds := Second;                              { Transfer seconds }
318   DT.Hundredths := Sec100;                           { Transfer hundredths }
319   DosSetDateTime(DT);                                { Set the time }
320END;
321{$ENDIF}
322{$ifdef OS_UNIX}
323BEGIN
324 {settime is dummy in Linux}
325END;
326{$endif OS_UNIX}
327{$IFDEF OS_NETWARE}
328BEGIN
329 {settime is dummy in Netware (Libc and Clib) }
330END;
331{$ENDIF OS_NETWARE}
332{$IFDEF OS_AMIGA}
333BEGIN
334 { settime is dummy on Amiga }
335 { probably could be implemented, but it's low pri... (KB) }
336END;
337{$ENDIF OS_AMIGA}
338
339{---------------------------------------------------------------------------}
340{  GetTime -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Nov97 LdB           }
341{---------------------------------------------------------------------------}
342PROCEDURE GetTime (Var Hour, Minute, Second, Sec100: Word);
343{$IFDEF OS_DOS}                                       { DOS/DPMI CODE }
344   {$IFDEF ASM_BP}                                    { BP COMPATABLE ASM }
345   ASSEMBLER;
346   ASM
347     MOV AX, $2C00;                                   { Set function id }
348     PUSH BP;                                         { Safety save register }
349     INT $21;                                         { System get time }
350     POP BP;                                          { Restore register }
351     XOR AH, AH;                                      { Clear register }
352     CLD;                                             { Strings go forward }
353     MOV AL, DL;                                      { Transfer register }
354     LES DI, Sec100;                                  { ES:DI -> hundredths }
355     STOSW;                                           { Return hundredths }
356     MOV AL, DH;                                      { Transfer register }
357     LES DI, Second;                                  { ES:DI -> seconds }
358     STOSW;                                           { Return seconds }
359     MOV AL, CL;                                      { Transfer register }
360     LES DI, Minute;                                  { ES:DI -> minutes }
361     STOSW;                                           { Return minutes }
362     MOV AL, CH;                                      { Transfer register }
363     LES DI, Hour;                                    { ES:DI -> hours }
364     STOSW;                                           { Return hours }
365   END;
366   {$ENDIF}
367   {$IFDEF OS_GO32}                                   { FPC COMPATABLE ASM }
368   BEGIN
369   (* ASM
370     MOVW $0x2C00, %AX;                               { Set function id }
371     PUSHL %EBP;                                      { Save register }
372     INT $0x21;                                       { System get time }
373     POPL %EBP;                                       { Restore register }
374     XORB %AH, %AH;                                   { Clear register }
375     MOVB %DL, %AL;                                   { Transfer register }
376     MOVL Sec100, %EDI;                               { EDI -> Sec100 }
377     MOVW %AX, (%EDI);                                { Return Sec100 }
378     MOVB %DH, %AL;                                   { Transfer register }
379     MOVL Second, %EDI;                               { EDI -> Second }
380     MOVW %AX, (%EDI);                                { Return Second }
381     MOVB %CL, %AL;                                   { Transfer register }
382     MOVL Minute, %EDI;                               { EDI -> Minute }
383     MOVW %AX, (%EDI);                                { Return minute }
384     MOVB %CH, %AL;                                   { Transfer register }
385     MOVL Hour, %EDI;                                 { EDI -> Hour }
386     MOVW %AX, (%EDI);                                { Return hour }
387   END; *)
388   { direct call of real interrupt seems to render the system
389     unstable on Win2000 because some registers are not properly
390     restored if a mouse interrupt is generated while the Dos
391     interrupt is called... PM }
392     Dos.GetTime(Hour,Minute,Second,Sec100);
393   END;
394   {$ENDIF}
395{$ENDIF}
396{$IFDEF OS_WINDOWS}                                   { WIN/NT CODE }
397   {$IFDEF BIT_16}                                    { 16 BIT WINDOWS CODE }
398   ASSEMBLER;
399   ASM
400     MOV AX, $2C00;                                   { Set function id }
401     PUSH BP;                                         { Safety save register }
402     INT $21;                                         { System get time }
403     POP BP;                                          { Restore register }
404     XOR AH, AH;                                      { Clear register }
405     CLD;                                             { Strings go forward }
406     MOV AL, DL;                                      { Transfer register }
407     LES DI, Sec100;                                  { ES:DI -> hundredths }
408     STOSW;                                           { Return hundredths }
409     MOV AL, DH;                                      { Transfer register }
410     LES DI, Second;                                  { ES:DI -> seconds }
411     STOSW;                                           { Return seconds }
412     MOV AL, CL;                                      { Transfer register }
413     LES DI, Minute;                                  { ES:DI -> minutes }
414     STOSW;                                           { Return minutes }
415     MOV AL, CH;                                      { Transfer register }
416     LES DI, Hour;                                    { ES:DI -> hours }
417     STOSW;                                           { Return hours }
418   END;
419   {$ENDIF}
420   {$IFDEF BIT_32_OR_MORE}                            { 32 BIT WINDOWS CODE }
421   VAR DT: TSystemTime;
422   BEGIN
423     {$IFDEF PPC_FPC}                                 { FPC WINDOWS COMPILER }
424     GetLocalTime(@DT);                              { Get the date/time }
425     {$ELSE}                                          { OTHER COMPILERS }
426     GetLocalTime(DT);                               { Get the date/time }
427     {$ENDIF}
428     Hour := DT.wHour;                                { Transfer hour }
429     Minute := DT.wMinute;                            { Transfer minute }
430     Second := DT.wSecond;                            { Transfer seconds }
431     Sec100 := DT.wMilliseconds DIV 10;               { Transfer hundredths }
432   END;
433   {$ENDIF}
434{$ENDIF}
435{$IFDEF OS_OS2}                                       { OS2 CODE }
436VAR DT: DateTime;
437BEGIN
438   DosGetDateTime(DT);                                { Get the date/time }
439   Hour   := DT.Hours;                                { Transfer hour }
440   Minute := DT.Minutes;                              { Transfer minute }
441   Second := DT.Seconds;                              { Transfer seconds }
442   Sec100 := DT.Hundredths;                           { Transfer hundredths }
443END;
444{$ENDIF}
445{$ifdef OS_UNIX}
446BEGIN
447  Dos.GetTime(Hour,Minute,Second,Sec100);
448END;
449{$endif OS_UNIX}
450{$IFDEF OS_NETWARE}
451BEGIN
452  Dos.GetTime(Hour,Minute,Second,Sec100);
453END;
454{$ENDIF OS_NETWARE}
455{$IFDEF OS_AMIGA}
456BEGIN
457  Dos.GetTime(Hour,Minute,Second,Sec100);
458END;
459{$ENDIF OS_AMIGA}
460
461{---------------------------------------------------------------------------}
462{  MinutesToTime -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 19Jun97 LdB     }
463{---------------------------------------------------------------------------}
464PROCEDURE MinutesToTime (Md: LongInt; Var Hour24, Minute: Word);
465BEGIN
466   Hour24 := Md DIV 60;                               { Hours of time }
467   Minute := Md MOD 60;                               { Minutes of time }
468END;
469
470{---------------------------------------------------------------------------}
471{  SecondsToTime -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 19Jun97 LdB     }
472{---------------------------------------------------------------------------}
473PROCEDURE SecondsToTime (Sd: LongInt; Var Hour24, Minute, Second: Word);
474BEGIN
475   Hour24 := Sd DIV 3600;                             { Hours of time }
476   Minute := Sd MOD 3600 DIV 60;                      { Minutes of time }
477   Second := Sd MOD 60;                               { Seconds of time }
478END;
479
480END.