/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

  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. UNIT Time;
  48. {<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  49. INTERFACE
  50. {<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  51. {====Include file to sort compiler platform out =====================}
  52. {$I platform.inc}
  53. {====================================================================}
  54. {==== Compiler directives ===========================================}
  55. {$IFNDEF PPC_FPC} { FPC doesn't support these switches }
  56. {$F-} { Short calls are okay }
  57. {$A+} { Word Align Data }
  58. {$B-} { Allow short circuit boolean evaluations }
  59. {$O+} { This unit may be overlaid }
  60. {$G+} { 286 Code optimization - if you're on an 8088 get a real computer }
  61. {$E+} { Emulation is on }
  62. {$N-} { No 80x87 code generation }
  63. {$ENDIF}
  64. {$X+} { Extended syntax is ok }
  65. {$R-} { Disable range checking }
  66. {$S-} { Disable Stack Checking }
  67. {$I-} { Disable IO Checking }
  68. {$Q-} { Disable Overflow Checking }
  69. {$V-} { Turn off strict VAR strings }
  70. {====================================================================}
  71. {***************************************************************************}
  72. { INTERFACE ROUTINES }
  73. {***************************************************************************}
  74. {-CurrentMinuteOfDay-------------------------------------------------
  75. Returns the number of minutes since midnight of a current system time.
  76. 19Jun97 LdB (Range: 0 - 1439)
  77. ---------------------------------------------------------------------}
  78. FUNCTION CurrentMinuteOfDay: Word;
  79. {-CurrentSecondOfDay-------------------------------------------------
  80. Returns the number of seconds since midnight of current system time.
  81. 24Jun97 LdB (Range: 0 - 86399)
  82. ---------------------------------------------------------------------}
  83. FUNCTION CurrentSecondOfDay: LongInt;
  84. {-CurrentSec100OfDay-------------------------------------------------
  85. Returns the 1/100ths of a second since midnight of current system time.
  86. 24Jun97 LdB (Range: 0 - 8639999)
  87. ---------------------------------------------------------------------}
  88. FUNCTION CurrentSec100OfDay: LongInt;
  89. {-MinuteOfDay--------------------------------------------------------
  90. Returns the number of minutes since midnight of a valid given time.
  91. 19Jun97 LdB (Range: 0 - 1439)
  92. ---------------------------------------------------------------------}
  93. FUNCTION MinuteOfDay (Hour24, Minute: Word): Word;
  94. {-SecondOfDay--------------------------------------------------------
  95. Returns the number of seconds since midnight of a valid given time.
  96. 19Jun97 LdB (Range: 0 - 86399)
  97. ---------------------------------------------------------------------}
  98. FUNCTION SecondOfDay (Hour24, Minute, Second: Word): LongInt;
  99. {-SetTime------------------------------------------------------------
  100. Set the operating systems time clock to the given values. If values
  101. are invalid this function will fail without notification.
  102. 06Nov97 LdB
  103. ---------------------------------------------------------------------}
  104. PROCEDURE SetTime (Hour, Minute, Second, Sec100: Word);
  105. {-GetTime------------------------------------------------------------
  106. Returns the current time settings of the operating system.
  107. 06Nov97 LdB
  108. ---------------------------------------------------------------------}
  109. PROCEDURE GetTime (Var Hour, Minute, Second, Sec100: Word);
  110. {-MinutesToTime------------------------------------------------------
  111. Returns the time in hours and minutes of a given number of minutes.
  112. 19Jun97 LdB
  113. ---------------------------------------------------------------------}
  114. PROCEDURE MinutesToTime (Md: LongInt; Var Hour24, Minute: Word);
  115. {-SecondsToTime------------------------------------------------------
  116. Returns the time in hours, mins and secs of a given number of seconds.
  117. 19Jun97 LdB
  118. ---------------------------------------------------------------------}
  119. PROCEDURE SecondsToTime (Sd: LongInt; Var Hour24, Minute, Second: Word);
  120. {<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  121. IMPLEMENTATION
  122. {<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  123. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  124. {$IFNDEF PPC_SPEED} { NON SPEED COMPILER }
  125. {$IFDEF PPC_FPC} { FPC WINDOWS COMPILER }
  126. USEs Windows; { Standard unit }
  127. {$ELSE} { OTHER COMPILERS }
  128. USES WinTypes, WinProcs; { Standard units }
  129. {$ENDIF}
  130. {$ELSE} { SPEEDSOFT COMPILER }
  131. USES WinBase; { Standard unit }
  132. TYPE TSystemTime = SystemTime; { Type fix up }
  133. {$ENDIF}
  134. {$ENDIF}
  135. {$IFDEF OS_OS2} { OS2 COMPILERS }
  136. {$IFDEF PPC_VIRTUAL} { VIRTUAL PASCAL }
  137. USES OS2Base; { Standard unit }
  138. {$ENDIF}
  139. {$IFDEF PPC_SPEED} { SPEED PASCAL }
  140. USES BseDos, Os2Def; { Standard unit }
  141. {$ENDIF}
  142. {$IFDEF PPC_FPC} { FPC }
  143. USES Dos, DosCalls; { Standard unit }
  144. TYPE DateTime = TDateTime; { Type correction }
  145. {$ENDIF}
  146. {$IFDEF PPC_BPOS2} { C'T PATCH TO BP CODE }
  147. USES DosTypes, DosProcs; { Standard unit }
  148. TYPE DateTime = TDateTime; { Type correction }
  149. {$ENDIF}
  150. {$ENDIF}
  151. {$ifdef OS_UNIX}
  152. USES Dos;
  153. {$endif OS_UNIX}
  154. {$ifdef OS_GO32}
  155. USES Dos;
  156. {$endif OS_GO32}
  157. {$ifdef OS_NETWARE}
  158. USES Dos;
  159. {$endif OS_NETWARE}
  160. {$ifdef OS_AMIGA}
  161. USES Dos;
  162. {$endif OS_AMIGA}
  163. {***************************************************************************}
  164. { INTERFACE ROUTINES }
  165. {***************************************************************************}
  166. {---------------------------------------------------------------------------}
  167. { CurrentMinuteOfDay -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 24Jun97 LdB}
  168. {---------------------------------------------------------------------------}
  169. FUNCTION CurrentMinuteOfDay: Word;
  170. VAR Hour, Minute, Second, Sec100: Word;
  171. BEGIN
  172. GetTime(Hour, Minute, Second, Sec100); { Get current time }
  173. CurrentMinuteOfDay := (Hour * 60) + Minute; { Minute from midnight }
  174. END;
  175. {---------------------------------------------------------------------------}
  176. { CurrentSecondOfDay -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 24Jun97 LdB}
  177. {---------------------------------------------------------------------------}
  178. FUNCTION CurrentSecondOfDay: LongInt;
  179. VAR Hour, Minute, Second, Sec100: Word;
  180. BEGIN
  181. GetTime(Hour, Minute, Second, Sec100); { Get current time }
  182. CurrentSecondOfDay := (LongInt(Hour) * 3600) +
  183. (Minute * 60) + Second; { Second from midnight }
  184. END;
  185. {---------------------------------------------------------------------------}
  186. { CurrentSec100OfDay -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 24Jun97 LdB}
  187. {---------------------------------------------------------------------------}
  188. FUNCTION CurrentSec100OfDay: LongInt;
  189. VAR Hour, Minute, Second, Sec100: Word;
  190. BEGIN
  191. GetTime(Hour, Minute, Second, Sec100); { Get current time }
  192. CurrentSec100OfDay := (LongInt(Hour) * 360000) +
  193. (LongInt(Minute) * 6000) + (Second*100)+ Sec100; { Sec100 from midnight }
  194. END;
  195. {---------------------------------------------------------------------------}
  196. { MinuteOfDay -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 19Jun97 LdB }
  197. {---------------------------------------------------------------------------}
  198. FUNCTION MinuteOfDay (Hour24, Minute: Word): Word;
  199. BEGIN
  200. MinuteOfDay := (Hour24 * 60) + Minute; { Minute from midnight }
  201. END;
  202. {---------------------------------------------------------------------------}
  203. { SecondOfDay -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 19Jun97 LdB }
  204. {---------------------------------------------------------------------------}
  205. FUNCTION SecondOfDay (Hour24, Minute, Second: Word): LongInt;
  206. BEGIN
  207. SecondOfDay := (LongInt(Hour24) * 3600) +
  208. (Minute * 60) + Second; { Second from midnight }
  209. END;
  210. {---------------------------------------------------------------------------}
  211. { SetTime -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Nov97 LdB }
  212. {---------------------------------------------------------------------------}
  213. PROCEDURE SetTime (Hour, Minute, Second, Sec100: Word);
  214. {$IFDEF OS_DOS} { DOS/DPMI CODE }
  215. {$IFDEF ASM_BP} { BP COMPATABLE ASM }
  216. ASSEMBLER;
  217. ASM
  218. MOV CH, BYTE PTR Hour; { Fetch hour }
  219. MOV CL, BYTE PTR Minute; { Fetch minute }
  220. MOV DH, BYTE PTR Second; { Fetch second }
  221. MOV DL, BYTE PTR Sec100; { Fetch hundredths }
  222. MOV AX, $2D00; { Set function id }
  223. PUSH BP; { Safety save register }
  224. INT $21; { Set the time }
  225. POP BP; { Restore register }
  226. END;
  227. {$ENDIF}
  228. {$IFDEF ASM_FPC} { FPC COMPATABLE ASM }
  229. BEGIN
  230. ASM
  231. MOVB Hour, %CH; { Fetch hour }
  232. MOVB Minute, %CL; { Fetch minute }
  233. MOVB Second, %DH; { Fetch second }
  234. MOVB Sec100, %DL; { Fetch hundredths }
  235. MOVW $0x2D00, %AX; { Set function id }
  236. PUSHL %EBP; { Save register }
  237. INT $0x21; { BIOS set time }
  238. POPL %EBP; { Restore register }
  239. END;
  240. END;
  241. {$ENDIF}
  242. {$ENDIF}
  243. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  244. {$IFDEF BIT_16} { 16 BIT WINDOWS CODE }
  245. ASSEMBLER;
  246. ASM
  247. MOV CH, BYTE PTR Hour; { Fetch hour }
  248. MOV CL, BYTE PTR Minute; { Fetch minute }
  249. MOV DH, BYTE PTR Second; { Fetch second }
  250. MOV DL, BYTE PTR Sec100; { Fetch hundredths }
  251. MOV AX, $2D00; { Set function id }
  252. PUSH BP; { Safety save register }
  253. INT $21; { Set the time }
  254. POP BP; { Restore register }
  255. END;
  256. {$ENDIF}
  257. {$IFDEF BIT_32_OR_MORE} { 32 BIT WINDOWS CODE }
  258. VAR DT: TSystemTime;
  259. BEGIN
  260. {$IFDEF PPC_FPC} { FPC WINDOWS COMPILER }
  261. GetLocalTime(@DT); { Get the date/time }
  262. {$ELSE} { OTHER COMPILERS }
  263. GetLocalTime(DT); { Get the date/time }
  264. {$ENDIF}
  265. DT.wHour := Hour; { Transfer hour }
  266. DT.wMinute := Minute; { Transfer minute }
  267. DT.wSecond := Second; { Transfer seconds }
  268. DT.wMilliseconds := Sec100 * 10; { Transfer millisecs }
  269. SetLocalTime(DT); { Set the date/time }
  270. END;
  271. {$ENDIF}
  272. {$ENDIF}
  273. {$IFDEF OS_OS2} { OS2 CODE }
  274. VAR DT: DateTime;
  275. BEGIN
  276. DosGetDateTime(DT); { Get the date/time }
  277. DT.Hours := Hour; { Transfer hour }
  278. DT.Minutes := Minute; { Transfer minute }
  279. DT.Seconds := Second; { Transfer seconds }
  280. DT.Hundredths := Sec100; { Transfer hundredths }
  281. DosSetDateTime(DT); { Set the time }
  282. END;
  283. {$ENDIF}
  284. {$ifdef OS_UNIX}
  285. BEGIN
  286. {settime is dummy in Linux}
  287. END;
  288. {$endif OS_UNIX}
  289. {$IFDEF OS_NETWARE}
  290. BEGIN
  291. {settime is dummy in Netware (Libc and Clib) }
  292. END;
  293. {$ENDIF OS_NETWARE}
  294. {$IFDEF OS_AMIGA}
  295. BEGIN
  296. { settime is dummy on Amiga }
  297. { probably could be implemented, but it's low pri... (KB) }
  298. END;
  299. {$ENDIF OS_AMIGA}
  300. {---------------------------------------------------------------------------}
  301. { GetTime -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Nov97 LdB }
  302. {---------------------------------------------------------------------------}
  303. PROCEDURE GetTime (Var Hour, Minute, Second, Sec100: Word);
  304. {$IFDEF OS_DOS} { DOS/DPMI CODE }
  305. {$IFDEF ASM_BP} { BP COMPATABLE ASM }
  306. ASSEMBLER;
  307. ASM
  308. MOV AX, $2C00; { Set function id }
  309. PUSH BP; { Safety save register }
  310. INT $21; { System get time }
  311. POP BP; { Restore register }
  312. XOR AH, AH; { Clear register }
  313. CLD; { Strings go forward }
  314. MOV AL, DL; { Transfer register }
  315. LES DI, Sec100; { ES:DI -> hundredths }
  316. STOSW; { Return hundredths }
  317. MOV AL, DH; { Transfer register }
  318. LES DI, Second; { ES:DI -> seconds }
  319. STOSW; { Return seconds }
  320. MOV AL, CL; { Transfer register }
  321. LES DI, Minute; { ES:DI -> minutes }
  322. STOSW; { Return minutes }
  323. MOV AL, CH; { Transfer register }
  324. LES DI, Hour; { ES:DI -> hours }
  325. STOSW; { Return hours }
  326. END;
  327. {$ENDIF}
  328. {$IFDEF OS_GO32} { FPC COMPATABLE ASM }
  329. BEGIN
  330. (* ASM
  331. MOVW $0x2C00, %AX; { Set function id }
  332. PUSHL %EBP; { Save register }
  333. INT $0x21; { System get time }
  334. POPL %EBP; { Restore register }
  335. XORB %AH, %AH; { Clear register }
  336. MOVB %DL, %AL; { Transfer register }
  337. MOVL Sec100, %EDI; { EDI -> Sec100 }
  338. MOVW %AX, (%EDI); { Return Sec100 }
  339. MOVB %DH, %AL; { Transfer register }
  340. MOVL Second, %EDI; { EDI -> Second }
  341. MOVW %AX, (%EDI); { Return Second }
  342. MOVB %CL, %AL; { Transfer register }
  343. MOVL Minute, %EDI; { EDI -> Minute }
  344. MOVW %AX, (%EDI); { Return minute }
  345. MOVB %CH, %AL; { Transfer register }
  346. MOVL Hour, %EDI; { EDI -> Hour }
  347. MOVW %AX, (%EDI); { Return hour }
  348. END; *)
  349. { direct call of real interrupt seems to render the system
  350. unstable on Win2000 because some registers are not properly
  351. restored if a mouse interrupt is generated while the Dos
  352. interrupt is called... PM }
  353. Dos.GetTime(Hour,Minute,Second,Sec100);
  354. END;
  355. {$ENDIF}
  356. {$ENDIF}
  357. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  358. {$IFDEF BIT_16} { 16 BIT WINDOWS CODE }
  359. ASSEMBLER;
  360. ASM
  361. MOV AX, $2C00; { Set function id }
  362. PUSH BP; { Safety save register }
  363. INT $21; { System get time }
  364. POP BP; { Restore register }
  365. XOR AH, AH; { Clear register }
  366. CLD; { Strings go forward }
  367. MOV AL, DL; { Transfer register }
  368. LES DI, Sec100; { ES:DI -> hundredths }
  369. STOSW; { Return hundredths }
  370. MOV AL, DH; { Transfer register }
  371. LES DI, Second; { ES:DI -> seconds }
  372. STOSW; { Return seconds }
  373. MOV AL, CL; { Transfer register }
  374. LES DI, Minute; { ES:DI -> minutes }
  375. STOSW; { Return minutes }
  376. MOV AL, CH; { Transfer register }
  377. LES DI, Hour; { ES:DI -> hours }
  378. STOSW; { Return hours }
  379. END;
  380. {$ENDIF}
  381. {$IFDEF BIT_32_OR_MORE} { 32 BIT WINDOWS CODE }
  382. VAR DT: TSystemTime;
  383. BEGIN
  384. {$IFDEF PPC_FPC} { FPC WINDOWS COMPILER }
  385. GetLocalTime(@DT); { Get the date/time }
  386. {$ELSE} { OTHER COMPILERS }
  387. GetLocalTime(DT); { Get the date/time }
  388. {$ENDIF}
  389. Hour := DT.wHour; { Transfer hour }
  390. Minute := DT.wMinute; { Transfer minute }
  391. Second := DT.wSecond; { Transfer seconds }
  392. Sec100 := DT.wMilliseconds DIV 10; { Transfer hundredths }
  393. END;
  394. {$ENDIF}
  395. {$ENDIF}
  396. {$IFDEF OS_OS2} { OS2 CODE }
  397. VAR DT: DateTime;
  398. BEGIN
  399. DosGetDateTime(DT); { Get the date/time }
  400. Hour := DT.Hours; { Transfer hour }
  401. Minute := DT.Minutes; { Transfer minute }
  402. Second := DT.Seconds; { Transfer seconds }
  403. Sec100 := DT.Hundredths; { Transfer hundredths }
  404. END;
  405. {$ENDIF}
  406. {$ifdef OS_UNIX}
  407. BEGIN
  408. Dos.GetTime(Hour,Minute,Second,Sec100);
  409. END;
  410. {$endif OS_UNIX}
  411. {$IFDEF OS_NETWARE}
  412. BEGIN
  413. Dos.GetTime(Hour,Minute,Second,Sec100);
  414. END;
  415. {$ENDIF OS_NETWARE}
  416. {$IFDEF OS_AMIGA}
  417. BEGIN
  418. Dos.GetTime(Hour,Minute,Second,Sec100);
  419. END;
  420. {$ENDIF OS_AMIGA}
  421. {---------------------------------------------------------------------------}
  422. { MinutesToTime -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 19Jun97 LdB }
  423. {---------------------------------------------------------------------------}
  424. PROCEDURE MinutesToTime (Md: LongInt; Var Hour24, Minute: Word);
  425. BEGIN
  426. Hour24 := Md DIV 60; { Hours of time }
  427. Minute := Md MOD 60; { Minutes of time }
  428. END;
  429. {---------------------------------------------------------------------------}
  430. { SecondsToTime -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 19Jun97 LdB }
  431. {---------------------------------------------------------------------------}
  432. PROCEDURE SecondsToTime (Sd: LongInt; Var Hour24, Minute, Second: Word);
  433. BEGIN
  434. Hour24 := Sd DIV 3600; { Hours of time }
  435. Minute := Sd MOD 3600 DIV 60; { Minutes of time }
  436. Second := Sd MOD 60; { Seconds of time }
  437. END;
  438. END.