time.pas 30 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606
  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. 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. {$IFDEF BIT_16}
  230. ASSEMBLER;
  231. ASM
  232. MOV CH, BYTE PTR Hour; { Fetch hour }
  233. MOV CL, BYTE PTR Minute; { Fetch minute }
  234. MOV DH, BYTE PTR Second; { Fetch second }
  235. MOV DL, BYTE PTR Sec100; { Fetch hundredths }
  236. MOV AX, $2D00; { Set function id }
  237. PUSH BP; { Safety save register }
  238. INT $21; { Set the time }
  239. POP BP; { Restore register }
  240. END;
  241. {$ELSE}
  242. BEGIN
  243. ASM
  244. MOVB Hour, %CH; { Fetch hour }
  245. MOVB Minute, %CL; { Fetch minute }
  246. MOVB Second, %DH; { Fetch second }
  247. MOVB Sec100, %DL; { Fetch hundredths }
  248. MOVW $0x2D00, %AX; { Set function id }
  249. PUSHL %EBP; { Save register }
  250. INT $0x21; { BIOS set time }
  251. POPL %EBP; { Restore register }
  252. END;
  253. END;
  254. {$ENDIF}
  255. {$ENDIF}
  256. {$ENDIF}
  257. {$IFDEF OS_WIN16} { 16 BIT WINDOWS CODE }
  258. ASSEMBLER;
  259. ASM
  260. MOV CH, BYTE PTR Hour; { Fetch hour }
  261. MOV CL, BYTE PTR Minute; { Fetch minute }
  262. MOV DH, BYTE PTR Second; { Fetch second }
  263. MOV DL, BYTE PTR Sec100; { Fetch hundredths }
  264. MOV AX, $2D00; { Set function id }
  265. PUSH BP; { Safety save register }
  266. INT $21; { Set the time }
  267. POP BP; { Restore register }
  268. END;
  269. {$ENDIF}
  270. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  271. {$IFDEF BIT_16} { 16 BIT WINDOWS CODE }
  272. ASSEMBLER;
  273. ASM
  274. MOV CH, BYTE PTR Hour; { Fetch hour }
  275. MOV CL, BYTE PTR Minute; { Fetch minute }
  276. MOV DH, BYTE PTR Second; { Fetch second }
  277. MOV DL, BYTE PTR Sec100; { Fetch hundredths }
  278. MOV AX, $2D00; { Set function id }
  279. PUSH BP; { Safety save register }
  280. INT $21; { Set the time }
  281. POP BP; { Restore register }
  282. END;
  283. {$ENDIF}
  284. {$IFDEF BIT_32_OR_MORE} { 32 BIT WINDOWS CODE }
  285. VAR DT: TSystemTime;
  286. BEGIN
  287. {$IFDEF PPC_FPC} { FPC WINDOWS COMPILER }
  288. GetLocalTime(@DT); { Get the date/time }
  289. {$ELSE} { OTHER COMPILERS }
  290. GetLocalTime(DT); { Get the date/time }
  291. {$ENDIF}
  292. DT.wHour := Hour; { Transfer hour }
  293. DT.wMinute := Minute; { Transfer minute }
  294. DT.wSecond := Second; { Transfer seconds }
  295. DT.wMilliseconds := Sec100 * 10; { Transfer millisecs }
  296. SetLocalTime(DT); { Set the date/time }
  297. END;
  298. {$ENDIF}
  299. {$ENDIF}
  300. {$IFDEF OS_OS2} { OS2 CODE }
  301. VAR DT: DateTime;
  302. BEGIN
  303. DosGetDateTime(DT); { Get the date/time }
  304. DT.Hours := Hour; { Transfer hour }
  305. DT.Minutes := Minute; { Transfer minute }
  306. DT.Seconds := Second; { Transfer seconds }
  307. DT.Hundredths := Sec100; { Transfer hundredths }
  308. DosSetDateTime(DT); { Set the time }
  309. END;
  310. {$ENDIF}
  311. {$ifdef OS_UNIX}
  312. BEGIN
  313. {settime is dummy in Linux}
  314. END;
  315. {$endif OS_UNIX}
  316. {$IFDEF OS_NETWARE}
  317. BEGIN
  318. {settime is dummy in Netware (Libc and Clib) }
  319. END;
  320. {$ENDIF OS_NETWARE}
  321. {$IFDEF OS_AMIGA}
  322. BEGIN
  323. { settime is dummy on Amiga }
  324. { probably could be implemented, but it's low pri... (KB) }
  325. END;
  326. {$ENDIF OS_AMIGA}
  327. {---------------------------------------------------------------------------}
  328. { GetTime -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Nov97 LdB }
  329. {---------------------------------------------------------------------------}
  330. PROCEDURE GetTime (Var Hour, Minute, Second, Sec100: Word);
  331. {$IFDEF OS_DOS} { DOS/DPMI CODE }
  332. {$IFDEF ASM_BP} { BP COMPATABLE ASM }
  333. ASSEMBLER;
  334. ASM
  335. MOV AX, $2C00; { Set function id }
  336. PUSH BP; { Safety save register }
  337. INT $21; { System get time }
  338. POP BP; { Restore register }
  339. XOR AH, AH; { Clear register }
  340. CLD; { Strings go forward }
  341. MOV AL, DL; { Transfer register }
  342. LES DI, Sec100; { ES:DI -> hundredths }
  343. STOSW; { Return hundredths }
  344. MOV AL, DH; { Transfer register }
  345. LES DI, Second; { ES:DI -> seconds }
  346. STOSW; { Return seconds }
  347. MOV AL, CL; { Transfer register }
  348. LES DI, Minute; { ES:DI -> minutes }
  349. STOSW; { Return minutes }
  350. MOV AL, CH; { Transfer register }
  351. LES DI, Hour; { ES:DI -> hours }
  352. STOSW; { Return hours }
  353. END;
  354. {$ENDIF}
  355. {$IFDEF ASM_FPC} { FPC COMPATABLE ASM }
  356. {$IFDEF BIT_16}
  357. {$IFDEF FPC_X86_DATA_NEAR}
  358. ASSEMBLER;
  359. ASM
  360. MOV AX, $2C00; { Set function id }
  361. PUSH BP; { Safety save register }
  362. INT $21; { System get time }
  363. POP BP; { Restore register }
  364. XOR AH, AH; { Clear register }
  365. CLD; { Strings go forward }
  366. MOV AL, DL; { Transfer register }
  367. PUSH DS
  368. POP ES
  369. MOV DI, Sec100; { ES:DI -> hundredths }
  370. STOSW; { Return hundredths }
  371. MOV AL, DH; { Transfer register }
  372. MOV DI, Second; { ES:DI -> seconds }
  373. STOSW; { Return seconds }
  374. MOV AL, CL; { Transfer register }
  375. MOV DI, Minute; { ES:DI -> minutes }
  376. STOSW; { Return minutes }
  377. MOV AL, CH; { Transfer register }
  378. MOV DI, Hour; { ES:DI -> hours }
  379. STOSW; { Return hours }
  380. END;
  381. {$ELSE FPC_X86_DATA_NEAR}
  382. ASSEMBLER;
  383. ASM
  384. MOV AX, $2C00; { Set function id }
  385. PUSH BP; { Safety save register }
  386. INT $21; { System get time }
  387. POP BP; { Restore register }
  388. XOR AH, AH; { Clear register }
  389. CLD; { Strings go forward }
  390. MOV AL, DL; { Transfer register }
  391. LES DI, Sec100; { ES:DI -> hundredths }
  392. STOSW; { Return hundredths }
  393. MOV AL, DH; { Transfer register }
  394. LES DI, Second; { ES:DI -> seconds }
  395. STOSW; { Return seconds }
  396. MOV AL, CL; { Transfer register }
  397. LES DI, Minute; { ES:DI -> minutes }
  398. STOSW; { Return minutes }
  399. MOV AL, CH; { Transfer register }
  400. LES DI, Hour; { ES:DI -> hours }
  401. STOSW; { Return hours }
  402. END;
  403. {$ENDIF}
  404. {$ELSE}
  405. BEGIN
  406. (* ASM
  407. MOVW $0x2C00, %AX; { Set function id }
  408. PUSHL %EBP; { Save register }
  409. INT $0x21; { System get time }
  410. POPL %EBP; { Restore register }
  411. XORB %AH, %AH; { Clear register }
  412. MOVB %DL, %AL; { Transfer register }
  413. MOVL Sec100, %EDI; { EDI -> Sec100 }
  414. MOVW %AX, (%EDI); { Return Sec100 }
  415. MOVB %DH, %AL; { Transfer register }
  416. MOVL Second, %EDI; { EDI -> Second }
  417. MOVW %AX, (%EDI); { Return Second }
  418. MOVB %CL, %AL; { Transfer register }
  419. MOVL Minute, %EDI; { EDI -> Minute }
  420. MOVW %AX, (%EDI); { Return minute }
  421. MOVB %CH, %AL; { Transfer register }
  422. MOVL Hour, %EDI; { EDI -> Hour }
  423. MOVW %AX, (%EDI); { Return hour }
  424. END; *)
  425. { direct call of real interrupt seems to render the system
  426. unstable on Win2000 because some registers are not properly
  427. restored if a mouse interrupt is generated while the Dos
  428. interrupt is called... PM }
  429. Dos.GetTime(Hour,Minute,Second,Sec100);
  430. END;
  431. {$ENDIF}
  432. {$ENDIF}
  433. {$ENDIF}
  434. {$IFDEF OS_WIN16} { 16 BIT WINDOWS CODE }
  435. {$IFDEF FPC_X86_DATA_NEAR}
  436. ASSEMBLER;
  437. ASM
  438. MOV AX, $2C00; { Set function id }
  439. PUSH BP; { Safety save register }
  440. INT $21; { System get time }
  441. POP BP; { Restore register }
  442. XOR AH, AH; { Clear register }
  443. CLD; { Strings go forward }
  444. MOV AL, DL; { Transfer register }
  445. PUSH DS
  446. POP ES
  447. MOV DI, Sec100; { ES:DI -> hundredths }
  448. STOSW; { Return hundredths }
  449. MOV AL, DH; { Transfer register }
  450. MOV DI, Second; { ES:DI -> seconds }
  451. STOSW; { Return seconds }
  452. MOV AL, CL; { Transfer register }
  453. MOV DI, Minute; { ES:DI -> minutes }
  454. STOSW; { Return minutes }
  455. MOV AL, CH; { Transfer register }
  456. MOV DI, Hour; { ES:DI -> hours }
  457. STOSW; { Return hours }
  458. END;
  459. {$ELSE FPC_X86_DATA_NEAR}
  460. ASSEMBLER;
  461. ASM
  462. MOV AX, $2C00; { Set function id }
  463. PUSH BP; { Safety save register }
  464. INT $21; { System get time }
  465. POP BP; { Restore register }
  466. XOR AH, AH; { Clear register }
  467. CLD; { Strings go forward }
  468. MOV AL, DL; { Transfer register }
  469. LES DI, Sec100; { ES:DI -> hundredths }
  470. STOSW; { Return hundredths }
  471. MOV AL, DH; { Transfer register }
  472. LES DI, Second; { ES:DI -> seconds }
  473. STOSW; { Return seconds }
  474. MOV AL, CL; { Transfer register }
  475. LES DI, Minute; { ES:DI -> minutes }
  476. STOSW; { Return minutes }
  477. MOV AL, CH; { Transfer register }
  478. LES DI, Hour; { ES:DI -> hours }
  479. STOSW; { Return hours }
  480. END;
  481. {$ENDIF}
  482. {$ENDIF}
  483. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  484. {$IFDEF BIT_16} { 16 BIT WINDOWS CODE }
  485. ASSEMBLER;
  486. ASM
  487. MOV AX, $2C00; { Set function id }
  488. PUSH BP; { Safety save register }
  489. INT $21; { System get time }
  490. POP BP; { Restore register }
  491. XOR AH, AH; { Clear register }
  492. CLD; { Strings go forward }
  493. MOV AL, DL; { Transfer register }
  494. LES DI, Sec100; { ES:DI -> hundredths }
  495. STOSW; { Return hundredths }
  496. MOV AL, DH; { Transfer register }
  497. LES DI, Second; { ES:DI -> seconds }
  498. STOSW; { Return seconds }
  499. MOV AL, CL; { Transfer register }
  500. LES DI, Minute; { ES:DI -> minutes }
  501. STOSW; { Return minutes }
  502. MOV AL, CH; { Transfer register }
  503. LES DI, Hour; { ES:DI -> hours }
  504. STOSW; { Return hours }
  505. END;
  506. {$ENDIF}
  507. {$IFDEF BIT_32_OR_MORE} { 32 BIT WINDOWS CODE }
  508. VAR DT: TSystemTime;
  509. BEGIN
  510. {$IFDEF PPC_FPC} { FPC WINDOWS COMPILER }
  511. GetLocalTime(@DT); { Get the date/time }
  512. {$ELSE} { OTHER COMPILERS }
  513. GetLocalTime(DT); { Get the date/time }
  514. {$ENDIF}
  515. Hour := DT.wHour; { Transfer hour }
  516. Minute := DT.wMinute; { Transfer minute }
  517. Second := DT.wSecond; { Transfer seconds }
  518. Sec100 := DT.wMilliseconds DIV 10; { Transfer hundredths }
  519. END;
  520. {$ENDIF}
  521. {$ENDIF}
  522. {$IFDEF OS_OS2} { OS2 CODE }
  523. VAR DT: DateTime;
  524. BEGIN
  525. DosGetDateTime(DT); { Get the date/time }
  526. Hour := DT.Hours; { Transfer hour }
  527. Minute := DT.Minutes; { Transfer minute }
  528. Second := DT.Seconds; { Transfer seconds }
  529. Sec100 := DT.Hundredths; { Transfer hundredths }
  530. END;
  531. {$ENDIF}
  532. {$ifdef OS_UNIX}
  533. BEGIN
  534. Dos.GetTime(Hour,Minute,Second,Sec100);
  535. END;
  536. {$endif OS_UNIX}
  537. {$IFDEF OS_NETWARE}
  538. BEGIN
  539. Dos.GetTime(Hour,Minute,Second,Sec100);
  540. END;
  541. {$ENDIF OS_NETWARE}
  542. {$IFDEF OS_AMIGA}
  543. BEGIN
  544. Dos.GetTime(Hour,Minute,Second,Sec100);
  545. END;
  546. {$ENDIF OS_AMIGA}
  547. {---------------------------------------------------------------------------}
  548. { MinutesToTime -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 19Jun97 LdB }
  549. {---------------------------------------------------------------------------}
  550. PROCEDURE MinutesToTime (Md: LongInt; Var Hour24, Minute: Word);
  551. BEGIN
  552. Hour24 := Md DIV 60; { Hours of time }
  553. Minute := Md MOD 60; { Minutes of time }
  554. END;
  555. {---------------------------------------------------------------------------}
  556. { SecondsToTime -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 19Jun97 LdB }
  557. {---------------------------------------------------------------------------}
  558. PROCEDURE SecondsToTime (Sd: LongInt; Var Hour24, Minute, Second: Word);
  559. BEGIN
  560. Hour24 := Sd DIV 3600; { Hours of time }
  561. Minute := Sd MOD 3600 DIV 60; { Minutes of time }
  562. Second := Sd MOD 60; { Seconds of time }
  563. END;
  564. END.