time.pas 30 KB

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