dbf_wtil.pas 24 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670
  1. unit dbf_wtil;
  2. {$I dbf_common.inc}
  3. interface
  4. {$ifndef WIN32}
  5. uses
  6. {$ifdef FPC}
  7. BaseUnix,
  8. {$else}
  9. Libc,
  10. {$endif}
  11. Types, SysUtils, Classes;
  12. const
  13. LCID_INSTALLED = $00000001; { installed locale ids }
  14. LCID_SUPPORTED = $00000002; { supported locale ids }
  15. CP_INSTALLED = $00000001; { installed code page ids }
  16. CP_SUPPORTED = $00000002; { supported code page ids }
  17. (*
  18. * Language IDs.
  19. *
  20. * The following two combinations of primary language ID and
  21. * sublanguage ID have special semantics:
  22. *
  23. * Primary Language ID Sublanguage ID Result
  24. * ------------------- --------------- ------------------------
  25. * LANG_NEUTRAL SUBLANG_NEUTRAL Language neutral
  26. * LANG_NEUTRAL SUBLANG_DEFAULT User default language
  27. * LANG_NEUTRAL SUBLANG_SYS_DEFAULT System default language
  28. *)
  29. { Primary language IDs. }
  30. LANG_NEUTRAL = $00;
  31. LANG_AFRIKAANS = $36;
  32. LANG_ALBANIAN = $1c;
  33. LANG_ARABIC = $01;
  34. LANG_BASQUE = $2d;
  35. LANG_BELARUSIAN = $23;
  36. LANG_BULGARIAN = $02;
  37. LANG_CATALAN = $03;
  38. LANG_CHINESE = $04;
  39. LANG_CROATIAN = $1a;
  40. LANG_CZECH = $05;
  41. LANG_DANISH = $06;
  42. LANG_DUTCH = $13;
  43. LANG_ENGLISH = $09;
  44. LANG_ESTONIAN = $25;
  45. LANG_FAEROESE = $38;
  46. LANG_FARSI = $29;
  47. LANG_FINNISH = $0b;
  48. LANG_FRENCH = $0c;
  49. LANG_GERMAN = $07;
  50. LANG_GREEK = $08;
  51. LANG_HEBREW = $0d;
  52. LANG_HUNGARIAN = $0e;
  53. LANG_ICELANDIC = $0f;
  54. LANG_INDONESIAN = $21;
  55. LANG_ITALIAN = $10;
  56. LANG_JAPANESE = $11;
  57. LANG_KOREAN = $12;
  58. LANG_LATVIAN = $26;
  59. LANG_LITHUANIAN = $27;
  60. LANG_NORWEGIAN = $14;
  61. LANG_POLISH = $15;
  62. LANG_PORTUGUESE = $16;
  63. LANG_ROMANIAN = $18;
  64. LANG_RUSSIAN = $19;
  65. LANG_SERBIAN = $1a;
  66. LANG_SLOVAK = $1b;
  67. LANG_SLOVENIAN = $24;
  68. LANG_SPANISH = $0a;
  69. LANG_SWEDISH = $1d;
  70. LANG_THAI = $1e;
  71. LANG_TURKISH = $1f;
  72. LANG_UKRAINIAN = $22;
  73. LANG_VIETNAMESE = $2a;
  74. { Sublanguage IDs. }
  75. { The name immediately following SUBLANG_ dictates which primary
  76. language ID that sublanguage ID can be combined with to form a
  77. valid language ID.
  78. }
  79. SUBLANG_NEUTRAL = $00; { language neutral }
  80. SUBLANG_DEFAULT = $01; { user default }
  81. SUBLANG_SYS_DEFAULT = $02; { system default }
  82. SUBLANG_ARABIC_SAUDI_ARABIA = $01; { Arabic (Saudi Arabia) }
  83. SUBLANG_ARABIC_IRAQ = $02; { Arabic (Iraq) }
  84. SUBLANG_ARABIC_EGYPT = $03; { Arabic (Egypt) }
  85. SUBLANG_ARABIC_LIBYA = $04; { Arabic (Libya) }
  86. SUBLANG_ARABIC_ALGERIA = $05; { Arabic (Algeria) }
  87. SUBLANG_ARABIC_MOROCCO = $06; { Arabic (Morocco) }
  88. SUBLANG_ARABIC_TUNISIA = $07; { Arabic (Tunisia) }
  89. SUBLANG_ARABIC_OMAN = $08; { Arabic (Oman) }
  90. SUBLANG_ARABIC_YEMEN = $09; { Arabic (Yemen) }
  91. SUBLANG_ARABIC_SYRIA = $0a; { Arabic (Syria) }
  92. SUBLANG_ARABIC_JORDAN = $0b; { Arabic (Jordan) }
  93. SUBLANG_ARABIC_LEBANON = $0c; { Arabic (Lebanon) }
  94. SUBLANG_ARABIC_KUWAIT = $0d; { Arabic (Kuwait) }
  95. SUBLANG_ARABIC_UAE = $0e; { Arabic (U.A.E) }
  96. SUBLANG_ARABIC_BAHRAIN = $0f; { Arabic (Bahrain) }
  97. SUBLANG_ARABIC_QATAR = $10; { Arabic (Qatar) }
  98. SUBLANG_CHINESE_TRADITIONAL = $01; { Chinese (Taiwan) }
  99. SUBLANG_CHINESE_SIMPLIFIED = $02; { Chinese (PR China) }
  100. SUBLANG_CHINESE_HONGKONG = $03; { Chinese (Hong Kong) }
  101. SUBLANG_CHINESE_SINGAPORE = $04; { Chinese (Singapore) }
  102. SUBLANG_DUTCH = $01; { Dutch }
  103. SUBLANG_DUTCH_BELGIAN = $02; { Dutch (Belgian) }
  104. SUBLANG_ENGLISH_US = $01; { English (USA) }
  105. SUBLANG_ENGLISH_UK = $02; { English (UK) }
  106. SUBLANG_ENGLISH_AUS = $03; { English (Australian) }
  107. SUBLANG_ENGLISH_CAN = $04; { English (Canadian) }
  108. SUBLANG_ENGLISH_NZ = $05; { English (New Zealand) }
  109. SUBLANG_ENGLISH_EIRE = $06; { English (Irish) }
  110. SUBLANG_ENGLISH_SOUTH_AFRICA = $07; { English (South Africa) }
  111. SUBLANG_ENGLISH_JAMAICA = $08; { English (Jamaica) }
  112. SUBLANG_ENGLISH_CARIBBEAN = $09; { English (Caribbean) }
  113. SUBLANG_ENGLISH_BELIZE = $0a; { English (Belize) }
  114. SUBLANG_ENGLISH_TRINIDAD = $0b; { English (Trinidad) }
  115. SUBLANG_FRENCH = $01; { French }
  116. SUBLANG_FRENCH_BELGIAN = $02; { French (Belgian) }
  117. SUBLANG_FRENCH_CANADIAN = $03; { French (Canadian) }
  118. SUBLANG_FRENCH_SWISS = $04; { French (Swiss) }
  119. SUBLANG_FRENCH_LUXEMBOURG = $05; { French (Luxembourg) }
  120. SUBLANG_GERMAN = $01; { German }
  121. SUBLANG_GERMAN_SWISS = $02; { German (Swiss) }
  122. SUBLANG_GERMAN_AUSTRIAN = $03; { German (Austrian) }
  123. SUBLANG_GERMAN_LUXEMBOURG = $04; { German (Luxembourg) }
  124. SUBLANG_GERMAN_LIECHTENSTEIN = $05; { German (Liechtenstein) }
  125. SUBLANG_ITALIAN = $01; { Italian }
  126. SUBLANG_ITALIAN_SWISS = $02; { Italian (Swiss) }
  127. SUBLANG_KOREAN = $01; { Korean (Extended Wansung) }
  128. SUBLANG_KOREAN_JOHAB = $02; { Korean (Johab) }
  129. SUBLANG_NORWEGIAN_BOKMAL = $01; { Norwegian (Bokmal) }
  130. SUBLANG_NORWEGIAN_NYNORSK = $02; { Norwegian (Nynorsk) }
  131. SUBLANG_PORTUGUESE = $02; { Portuguese }
  132. SUBLANG_PORTUGUESE_BRAZILIAN = $01; { Portuguese (Brazilian) }
  133. SUBLANG_SERBIAN_LATIN = $02; { Serbian (Latin) }
  134. SUBLANG_SERBIAN_CYRILLIC = $03; { Serbian (Cyrillic) }
  135. SUBLANG_SPANISH = $01; { Spanish (Castilian) }
  136. SUBLANG_SPANISH_MEXICAN = $02; { Spanish (Mexican) }
  137. SUBLANG_SPANISH_MODERN = $03; { Spanish (Modern) }
  138. SUBLANG_SPANISH_GUATEMALA = $04; { Spanish (Guatemala) }
  139. SUBLANG_SPANISH_COSTA_RICA = $05; { Spanish (Costa Rica) }
  140. SUBLANG_SPANISH_PANAMA = $06; { Spanish (Panama) }
  141. SUBLANG_SPANISH_DOMINICAN_REPUBLIC = $07; { Spanish (Dominican Republic) }
  142. SUBLANG_SPANISH_VENEZUELA = $08; { Spanish (Venezuela) }
  143. SUBLANG_SPANISH_COLOMBIA = $09; { Spanish (Colombia) }
  144. SUBLANG_SPANISH_PERU = $0a; { Spanish (Peru) }
  145. SUBLANG_SPANISH_ARGENTINA = $0b; { Spanish (Argentina) }
  146. SUBLANG_SPANISH_ECUADOR = $0c; { Spanish (Ecuador) }
  147. SUBLANG_SPANISH_CHILE = $0d; { Spanish (Chile) }
  148. SUBLANG_SPANISH_URUGUAY = $0e; { Spanish (Uruguay) }
  149. SUBLANG_SPANISH_PARAGUAY = $0f; { Spanish (Paraguay) }
  150. SUBLANG_SPANISH_BOLIVIA = $10; { Spanish (Bolivia) }
  151. SUBLANG_SPANISH_EL_SALVADOR = $11; { Spanish (El Salvador) }
  152. SUBLANG_SPANISH_HONDURAS = $12; { Spanish (Honduras) }
  153. SUBLANG_SPANISH_NICARAGUA = $13; { Spanish (Nicaragua) }
  154. SUBLANG_SPANISH_PUERTO_RICO = $14; { Spanish (Puerto Rico) }
  155. SUBLANG_SWEDISH = $01; { Swedish }
  156. SUBLANG_SWEDISH_FINLAND = $02; { Swedish (Finland) }
  157. { Sorting IDs. }
  158. SORT_DEFAULT = $0; { sorting default }
  159. SORT_JAPANESE_XJIS = $0; { Japanese XJIS order }
  160. SORT_JAPANESE_UNICODE = $1; { Japanese Unicode order }
  161. SORT_CHINESE_BIG5 = $0; { Chinese BIG5 order }
  162. SORT_CHINESE_PRCP = $0; { PRC Chinese Phonetic order }
  163. SORT_CHINESE_UNICODE = $1; { Chinese Unicode order }
  164. SORT_CHINESE_PRC = $2; { PRC Chinese Stroke Count order }
  165. SORT_KOREAN_KSC = $0; { Korean KSC order }
  166. SORT_KOREAN_UNICODE = $1; { Korean Unicode order }
  167. SORT_GERMAN_PHONE_BOOK = $1; { German Phone Book order }
  168. (*
  169. * A language ID is a 16 bit value which is the combination of a
  170. * primary language ID and a secondary language ID. The bits are
  171. * allocated as follows:
  172. *
  173. * +-----------------------+-------------------------+
  174. * | Sublanguage ID | Primary Language ID |
  175. * +-----------------------+-------------------------+
  176. * 15 10 9 0 bit
  177. *
  178. *
  179. *
  180. * A locale ID is a 32 bit value which is the combination of a
  181. * language ID, a sort ID, and a reserved area. The bits are
  182. * allocated as follows:
  183. *
  184. * +-------------+---------+-------------------------+
  185. * | Reserved | Sort ID | Language ID |
  186. * +-------------+---------+-------------------------+
  187. * 31 20 19 16 15 0 bit
  188. *
  189. *)
  190. { Default System and User IDs for language and locale. }
  191. LANG_SYSTEM_DEFAULT = (SUBLANG_SYS_DEFAULT shl 10) or LANG_NEUTRAL;
  192. LANG_USER_DEFAULT = (SUBLANG_DEFAULT shl 10) or LANG_NEUTRAL;
  193. LOCALE_SYSTEM_DEFAULT = (SORT_DEFAULT shl 16) or LANG_SYSTEM_DEFAULT;
  194. LOCALE_USER_DEFAULT = (SORT_DEFAULT shl 16) or LANG_USER_DEFAULT;
  195. (*
  196. Error const of File Locking
  197. *)
  198. {$ifdef FPC}
  199. ERROR_LOCK_VIOLATION = ESysEACCES;
  200. {$else}
  201. ERROR_LOCK_VIOLATION = EACCES;
  202. {$endif}
  203. { MBCS and Unicode Translation Flags. }
  204. MB_PRECOMPOSED = 1; { use precomposed chars }
  205. MB_COMPOSITE = 2; { use composite chars }
  206. MB_USEGLYPHCHARS = 4; { use glyph chars, not ctrl chars }
  207. type
  208. LCID = DWORD;
  209. BOOL = LongBool;
  210. PBOOL = ^BOOL;
  211. WCHAR = WideChar;
  212. PWChar = PWideChar;
  213. LPSTR = PAnsiChar;
  214. PLPSTR = ^LPSTR;
  215. LPCSTR = PAnsiChar;
  216. LPCTSTR = PAnsiChar; { should be PWideChar if UNICODE }
  217. LPTSTR = PAnsiChar; { should be PWideChar if UNICODE }
  218. LPWSTR = PWideChar;
  219. PLPWSTR = ^LPWSTR;
  220. LPCWSTR = PWideChar;
  221. { System time is represented with the following structure: }
  222. PSystemTime = ^TSystemTime;
  223. TSystemTime = record
  224. wYear: Word;
  225. wMonth: Word;
  226. wDayOfWeek: Word;
  227. wDay: Word;
  228. wHour: Word;
  229. wMinute: Word;
  230. wSecond: Word;
  231. wMilliseconds: Word;
  232. end;
  233. TFarProc = Pointer;
  234. TFNLocaleEnumProc = TFarProc;
  235. TFNCodepageEnumProc = TFarProc;
  236. TFNDateFmtEnumProc = TFarProc;
  237. TFNTimeFmtEnumProc = TFarProc;
  238. TFNCalInfoEnumProc = TFarProc;
  239. function LockFile(hFile: THandle; dwFileOffsetLow, dwFileOffsetHigh: DWORD; nNumberOfBytesToLockLow, nNumberOfBytesToLockHigh: DWORD): BOOL;
  240. function UnlockFile(hFile: THandle; dwFileOffsetLow, dwFileOffsetHigh: DWORD; nNumberOfBytesToUnlockLow, nNumberOfBytesToUnlockHigh: DWORD): BOOL;
  241. procedure GetLocalTime(var lpSystemTime: TSystemTime);
  242. function GetOEMCP: Cardinal;
  243. function GetACP: Cardinal;
  244. function OemToChar(lpszSrc: PChar; lpszDst: PChar): BOOL;
  245. function CharToOem(lpszSrc: PChar; lpszDst: PChar): BOOL;
  246. function OemToCharBuff(lpszSrc: PChar; lpszDst: PChar; cchDstLength: DWORD): BOOL;
  247. function CharToOemBuff(lpszSrc: PChar; lpszDst: PChar; cchDstLength: DWORD): BOOL;
  248. function MultiByteToWideChar(CodePage: DWORD; dwFlags: DWORD; const lpMultiByteStr: LPCSTR; cchMultiByte: Integer; lpWideCharStr: LPWSTR; cchWideChar: Integer): Integer;
  249. function WideCharToMultiByte(CodePage: DWORD; dwFlags: DWORD; lpWideCharStr: LPWSTR; cchWideChar: Integer; lpMultiByteStr: LPSTR; cchMultiByte: Integer; lpDefaultChar: LPCSTR; lpUsedDefaultChar: PBOOL): Integer;
  250. function CompareString(Locale: LCID; dwCmpFlags: DWORD; lpString1: PChar; cchCount1: Integer; lpString2: PChar; cchCount2: Integer): Integer;
  251. function EnumSystemCodePages(lpCodePageEnumProc: TFNCodepageEnumProc; dwFlags: DWORD): BOOL;
  252. function EnumSystemLocales(lpLocaleEnumProc: TFNLocaleEnumProc; dwFlags: DWORD): BOOL;
  253. function GetUserDefaultLCID: LCID;
  254. {$ifdef FPC}
  255. function GetLastError: Integer;
  256. procedure SetLastError(Value: Integer);
  257. {$endif}
  258. {$endif}
  259. implementation
  260. {$ifndef WIN32}
  261. {$ifdef FPC}
  262. uses
  263. unix;
  264. {$endif}
  265. (*
  266. NAME
  267. fcntl - manipulate file descriptor
  268. SYNOPSIS
  269. #include <unistd.h>
  270. #include <fcntl.h>
  271. int fcntl(int fd, int cmd);
  272. int fcntl(int fd, int cmd, long arg);
  273. int fcntl(int fd, int cmd, struct flock * lock);
  274. DESCRIPTION
  275. fcntl performs one of various miscellaneous operations on
  276. fd. The operation in question is determined by cmd:
  277. F_GETLK, F_SETLK and F_SETLKW are used to manage discreð
  278. tionary file locks. The third argument lock is a pointer
  279. to a struct flock (that may be overwritten by this call).
  280. F_GETLK
  281. Return the flock structure that prevents us from
  282. obtaining the lock, or set the l_type field of the
  283. lock to F_UNLCK if there is no obstruction.
  284. F_SETLK
  285. The lock is set (when l_type is F_RDLCK or F_WRLCK)
  286. or cleared (when it is F_UNLCK). If the lock is
  287. held by someone else, this call returns -1 and sets
  288. errno to EACCES or EAGAIN.
  289. F_SETLKW
  290. Like F_SETLK, but instead of returning an error we
  291. wait for the lock to be released. If a signal that
  292. is to be caught is received while fcntl is waiting,
  293. it is interrupted and (after the signal handler has
  294. returned) returns immediately (with return value -1
  295. and errno set to EINTR).
  296. Using these mechanisms, a program can implement fully
  297. asynchronous I/O without using select(2) or poll(2) most
  298. of the time.
  299. The use of O_ASYNC, F_GETOWN, F_SETOWN is specific to BSD
  300. and Linux. F_GETSIG and F_SETSIG are Linux-specific.
  301. POSIX has asynchronous I/O and the aio_sigevent structure
  302. to achieve similar things; these are also available in
  303. Linux as part of the GNU C Library (Glibc).
  304. RETURN VALUE
  305. For a successful call, the return value depends on the
  306. operation:
  307. F_GETFD Value of flag.
  308. F_GETFL Value of flags.
  309. F_GETOWN Value of descriptor owner.
  310. F_GETSIG Value of signal sent when read or write becomes
  311. possible, or zero for traditional SIGIO
  312. behaviour.
  313. All other commands
  314. Zero.
  315. On error, -1 is returned, and errno is set appropriately.
  316. ERRORS
  317. EACCES Operation is prohibited by locks held by other
  318. processes.
  319. EAGAIN Operation is prohibited because the file has been
  320. memory-mapped by another process.
  321. EBADF fd is not an open file descriptor.
  322. EDEADLK It was detected that the specified F_SETLKW comð
  323. mand would cause a deadlock.
  324. EFAULT lock is outside your accessible address space.
  325. EINTR For F_SETLKW, the command was interrupted by a
  326. signal. For F_GETLK and F_SETLK, the command was
  327. interrupted by a signal before the lock was
  328. checked or acquired. Most likely when locking a
  329. remote file (e.g. locking over NFS), but can
  330. sometimes happen locally.
  331. EINVAL For F_DUPFD, arg is negative or is greater than
  332. the maximum allowable value. For F_SETSIG, arg
  333. is not an allowable signal number.
  334. EMFILE For F_DUPFD, the process already has the maximum
  335. number of file descriptors open.
  336. ENOLCK Too many segment locks open, lock table is full,
  337. or a remote locking protocol failed (e.g. locking
  338. over NFS).
  339. EPERM Attempted to clear the O_APPEND flag on a file
  340. that has the append-only attribute set.
  341. typedef long __kernel_off_t;
  342. typedef int __kernel_pid_t;
  343. struct flock {
  344. short l_type;
  345. short l_whence;
  346. off_t l_start;
  347. off_t l_len;
  348. pid_t l_pid;
  349. };
  350. whence:
  351. --------
  352. const
  353. SEEK_SET = 0; { Seek from beginning of file. }
  354. SEEK_CUR = 1; { Seek from current position. }
  355. SEEK_END = 2; { Seek from end of file. }
  356. { Old BSD names for the same constants; just for compatibility. }
  357. L_SET = SEEK_SET;
  358. L_INCR = SEEK_CUR;
  359. L_XTND = SEEK_END;
  360. *)
  361. {$ifdef FPC}
  362. const
  363. F_RDLCK = 0;
  364. F_WRLCK = 1;
  365. F_UNLCK = 2;
  366. F_EXLCK = 4;
  367. F_SHLCK = 8;
  368. LOCK_SH = 1;
  369. LOCK_EX = 2;
  370. LOCK_NB = 4;
  371. LOCK_UN = 8;
  372. LOCK_MAND = 32;
  373. LOCK_READ = 64;
  374. LOCK_WRITE = 128;
  375. LOCK_RW = 192;
  376. EACCES = ESysEACCES;
  377. EAGAIN = ESysEAGAIN;
  378. {$endif}
  379. function LockFile(hFile: THandle; dwFileOffsetLow, dwFileOffsetHigh: DWORD; nNumberOfBytesToLockLow, nNumberOfBytesToLockHigh: DWORD): BOOL;
  380. var
  381. FLockInfo: {$ifdef FPC}BaseUnix.FLock{$else}TFLock{$endif};
  382. FLastError: Cardinal;
  383. begin
  384. FLockInfo.l_type := F_WRLCK;
  385. FLockInfo.l_whence := SEEK_SET;
  386. FLockInfo.l_start := dwFileOffsetLow;
  387. FLockInfo.l_len := nNumberOfBytesToLockLow;
  388. FLockInfo.l_pid := {$ifdef FPC}fpgetpid{$else}getpid{$endif}();
  389. Result := {$ifdef FPC}fpfcntl{$else}fcntl{$endif}(hFile, F_SETLK, FLockInfo) <> -1;
  390. if not Result then
  391. begin
  392. FLastError := GetLastError();
  393. if (FLastError = EACCES) or (FLastError = EAGAIN) then
  394. SetLastError(ERROR_LOCK_VIOLATION)
  395. else
  396. Result := True; // If errno is ENOLCK or EINVAL
  397. end;
  398. end;
  399. function UnlockFile(hFile: THandle; dwFileOffsetLow, dwFileOffsetHigh: DWORD; nNumberOfBytesToUnlockLow, nNumberOfBytesToUnlockHigh: DWORD): BOOL;
  400. var
  401. FLockInfo: {$ifdef FPC}BaseUnix.FLock{$else}TFLock{$endif};
  402. begin
  403. FLockInfo.l_type := F_UNLCK;
  404. FLockInfo.l_whence := SEEK_SET;
  405. FLockInfo.l_start := dwFileOffsetLow;
  406. FLockInfo.l_len := nNumberOfBytesToUnLockLow;
  407. FLockInfo.l_pid := {$ifdef FPC}fpgetpid{$else}getpid{$endif}();
  408. Result := {$ifdef FPC}fpfcntl{$else}fcntl{$endif}(hFile, F_SETLK, FLockInfo) <> -1;
  409. end;
  410. procedure DateTimeToSystemTime(const DateTime: TDateTime; var SystemTime: TSystemTime);
  411. begin
  412. with SystemTime do
  413. begin
  414. DecodeDateFully(DateTime, wYear, wMonth, wDay, wDayOfWeek);
  415. Dec(wDayOfWeek);
  416. DecodeTime(DateTime, wHour, wMinute, wSecond, wMilliseconds);
  417. end;
  418. end;
  419. function SystemTimeToDateTime(const SystemTime: TSystemTime): TDateTime;
  420. begin
  421. with SystemTime do
  422. begin
  423. Result := EncodeDate(wYear, wMonth, wDay);
  424. if Result >= 0 then
  425. Result := Result + EncodeTime(wHour, wMinute, wSecond, wMilliSeconds)
  426. else
  427. Result := Result - EncodeTime(wHour, wMinute, wSecond, wMilliSeconds);
  428. end;
  429. end;
  430. procedure GetLocalTime(var lpSystemTime: TSystemTime);
  431. begin
  432. DateTimeToSystemTime(NOW, lpSystemTime);
  433. end;
  434. function GetOEMCP: Cardinal;
  435. begin
  436. {$ifdef HUNGARIAN}
  437. Result := 852;
  438. {$else}
  439. Result := $FFFFFFFF;
  440. {$endif}
  441. end;
  442. function GetACP: Cardinal;
  443. begin
  444. {$ifdef HUNGARIAN}
  445. Result := 1250;
  446. {$else}
  447. Result := 1252;
  448. {$endif}
  449. end;
  450. {$ifdef HUNGARIAN}
  451. procedure OemHunHun(AnsiDst: PChar; cchDstLength: DWORD);
  452. var
  453. Count: DWORD;
  454. begin
  455. if Assigned(AnsiDst) and (cchDstLength<>0) then
  456. begin
  457. for Count:=0 to Pred(cchDstLength) do
  458. begin
  459. case AnsiDst^ of
  460. #160: AnsiDst^:= #225; {á}
  461. #143,#181: AnsiDst^:= #193; {Á}
  462. #130: AnsiDst^:= #233; {é}
  463. #144: AnsiDst^:= #201; {É}
  464. #161: AnsiDst^:= #237; {í}
  465. #141,#214: AnsiDst^:= #205; {Í}
  466. #162: AnsiDst^:= #243; {ó}
  467. #149,#224: AnsiDst^:= #211; {Ó}
  468. #148: AnsiDst^:= #246; {ö}
  469. #153: AnsiDst^:= #214; {Ö}
  470. #147,#139: AnsiDst^:= #245; {õ}
  471. #167,#138: AnsiDst^:= #213; {Õ}
  472. #163: AnsiDst^:= #250; {ú}
  473. #151,#233: AnsiDst^:= #218; {Ú}
  474. #129: AnsiDst^:= #252; {ü}
  475. #154: AnsiDst^:= #220; {Ü}
  476. #150,#251: AnsiDst^:= #251; {û}
  477. #152,#235: AnsiDst^:= #219; {Û}
  478. end;
  479. Inc(AnsiDst);
  480. end;
  481. end;
  482. end;
  483. procedure AnsiHunHun(AnsiDst: PChar; cchDstLength: DWORD);
  484. var
  485. Count: DWORD;
  486. begin
  487. if Assigned(AnsiDst) and (cchDstLength<>0) then
  488. begin
  489. for Count:=0 to Pred(cchDstLength) do
  490. begin
  491. case AnsiDst^ of
  492. #225: AnsiDst^:= #160; {á}
  493. #193: AnsiDst^:= #181; {Á}
  494. #233: AnsiDst^:= #130; {é}
  495. #201: AnsiDst^:= #144; {É}
  496. #237: AnsiDst^:= #161; {í}
  497. #205: AnsiDst^:= #214; {Í}
  498. #243: AnsiDst^:= #162; {ó}
  499. #211: AnsiDst^:= #224; {Ó}
  500. #246: AnsiDst^:= #148; {ö}
  501. #214: AnsiDst^:= #153; {Ö}
  502. #245: AnsiDst^:= #139; {õ}
  503. #213: AnsiDst^:= #138; {Õ}
  504. #250: AnsiDst^:= #163; {ú}
  505. #218: AnsiDst^:= #233; {Ú}
  506. #252: AnsiDst^:= #129; {ü}
  507. #220: AnsiDst^:= #154; {Ü}
  508. #251: AnsiDst^:= #251; {û}
  509. #219: AnsiDst^:= #235; {Û}
  510. end;
  511. Inc(AnsiDst);
  512. end;
  513. end;
  514. end;
  515. {$endif}
  516. function OemToChar(lpszSrc: PChar; lpszDst: PChar): BOOL;
  517. begin
  518. if lpszDst <> lpszSrc then
  519. StrCopy(lpszDst, lpszSrc);
  520. Result := true;
  521. end;
  522. function CharToOem(lpszSrc: PChar; lpszDst: PChar): BOOL;
  523. begin
  524. if lpszDst <> lpszSrc then
  525. StrCopy(lpszDst, lpszSrc);
  526. Result := true;
  527. end;
  528. function OemToCharBuff(lpszSrc: PChar; lpszDst: PChar; cchDstLength: DWORD): BOOL;
  529. begin
  530. if lpszDst <> lpszSrc then
  531. StrLCopy(lpszDst, lpszSrc, cchDstLength);
  532. {$ifdef HUNGARIAN}
  533. OemHunHun(lpszDst, cchDstLength);
  534. {$endif}
  535. Result := true;
  536. end;
  537. function CharToOemBuff(lpszSrc: PChar; lpszDst: PChar; cchDstLength: DWORD): BOOL;
  538. begin
  539. if lpszDst <> lpszSrc then
  540. StrLCopy(lpszDst, lpszSrc, cchDstLength);
  541. {$ifdef HUNGARIAN}
  542. AnsiHunHun(lpszDst, cchDstLength);
  543. {$endif}
  544. Result := true;
  545. end;
  546. function MultiByteToWideChar(CodePage: DWORD; dwFlags: DWORD; const lpMultiByteStr: LPCSTR; cchMultiByte: Integer; lpWideCharStr: LPWSTR; cchWideChar: Integer): Integer;
  547. var
  548. TempA: AnsiString;
  549. TempW: WideString;
  550. begin
  551. TempA := String(lpMultiByteStr^);
  552. TempW := TempA;
  553. Result := Length(TempW);
  554. System.Move(TempW, lpWideCharStr^, Result);
  555. end;
  556. function WideCharToMultiByte(CodePage: DWORD; dwFlags: DWORD; lpWideCharStr: LPWSTR; cchWideChar: Integer; lpMultiByteStr: LPSTR; cchMultiByte: Integer; lpDefaultChar: LPCSTR; lpUsedDefaultChar: PBOOL): Integer;
  557. var
  558. TempA: AnsiString;
  559. TempW: WideString;
  560. begin
  561. TempW := WideString(lpWideCharStr^);
  562. TempA := TempW;
  563. Result := Length(TempA);
  564. System.Move(TempA, lpMultiByteStr^, Result);
  565. end;
  566. function CompareString(Locale: LCID; dwCmpFlags: DWORD; lpString1: PChar; cchCount1: Integer; lpString2: PChar; cchCount2: Integer): Integer;
  567. begin
  568. Result := StrLComp(lpString1, lpString2, cchCount1) + 2;
  569. if Result > 2 then Result := 3;
  570. if Result < 2 then Result := 1;
  571. end;
  572. function EnumSystemCodePages(lpCodePageEnumProc: TFNCodepageEnumProc; dwFlags: DWORD): BOOL;
  573. begin
  574. Result := True;
  575. end;
  576. function EnumSystemLocales(lpLocaleEnumProc: TFNLocaleEnumProc; dwFlags: DWORD): BOOL;
  577. begin
  578. Result := True;
  579. end;
  580. function GetUserDefaultLCID: LCID;
  581. begin
  582. Result := LANG_ENGLISH or (SUBLANG_ENGLISH_UK shl 10);
  583. end;
  584. {$ifdef FPC}
  585. function GetLastError: Integer;
  586. begin
  587. Result := FpGetErrno;
  588. end;
  589. procedure SetLastError(Value: Integer);
  590. begin
  591. FpSetErrno(Value);
  592. end;
  593. {$endif}
  594. {$endif}
  595. end.