/packages/fv/src/time.pas
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.