dcosutils.pas 61 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151
  1. {
  2. Double Commander
  3. -------------------------------------------------------------------------
  4. This unit contains platform dependent functions dealing with operating system.
  5. Copyright (C) 2006-2025 Alexander Koblov ([email protected])
  6. This program is free software; you can redistribute it and/or modify
  7. it under the terms of the GNU General Public License as published by
  8. the Free Software Foundation; either version 2 of the License, or
  9. (at your option) any later version.
  10. This program is distributed in the hope that it will be useful,
  11. but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  13. GNU General Public License for more details.
  14. You should have received a copy of the GNU General Public License
  15. along with this program. If not, see <http://www.gnu.org/licenses/>.
  16. }
  17. unit DCOSUtils;
  18. {$mode objfpc}{$H+}
  19. {$modeswitch advancedrecords}
  20. interface
  21. uses
  22. SysUtils, Classes, DynLibs, DCClassesUtf8, DCBasicTypes, DCConvertEncoding
  23. {$IFDEF UNIX}
  24. , BaseUnix, DCUnix
  25. {$ENDIF}
  26. {$IFDEF LINUX}
  27. , DCLinux
  28. {$ENDIF}
  29. {$IFDEF DARWIN}
  30. , DCDarwin
  31. {$ENDIF}
  32. {$IFDEF HAIKU}
  33. , DCHaiku
  34. {$ENDIF}
  35. {$IFDEF MSWINDOWS}
  36. , JwaWinBase, Windows
  37. {$ENDIF}
  38. ;
  39. const
  40. fmOpenSync = $10000;
  41. fmOpenDirect = $20000;
  42. fmOpenNoATime = $40000;
  43. fmOpenSpecial = $80000;
  44. {$IF DEFINED(UNIX)}
  45. ERROR_NOT_SAME_DEVICE = ESysEXDEV;
  46. {$ELSE}
  47. ERROR_NOT_SAME_DEVICE = Windows.ERROR_NOT_SAME_DEVICE;
  48. {$ENDIF}
  49. FileNameNormalized = {$IFDEF DARWIN}True{$ELSE}False{$ENDIF};
  50. type
  51. TFileMapRec = record
  52. FileHandle : System.THandle;
  53. FileSize : Int64;
  54. {$IFDEF MSWINDOWS}
  55. MappingHandle : System.THandle;
  56. {$ENDIF}
  57. MappedFile : Pointer;
  58. end;
  59. TFileAttributeData = packed record
  60. Size: Int64;
  61. {$IF DEFINED(UNIX)}
  62. FindData: BaseUnix.Stat;
  63. property Attr: TUnixMode read FindData.st_mode;
  64. property PlatformTime: TUnixTime read FindData.st_ctime;
  65. property LastWriteTime: TUnixTime read FindData.st_mtime;
  66. property LastAccessTime: TUnixTime read FindData.st_atime;
  67. {$ELSE}
  68. case Boolean of
  69. True: (
  70. FindData: Windows.TWin32FileAttributeData;
  71. );
  72. False: (
  73. Attr: TFileAttrs;
  74. PlatformTime: DCBasicTypes.TFileTime;
  75. LastAccessTime: DCBasicTypes.TFileTime;
  76. LastWriteTime: DCBasicTypes.TFileTime;
  77. );
  78. {$ENDIF}
  79. end;
  80. TCopyAttributesOption = (caoCopyAttributes,
  81. caoCopyTime,
  82. caoCopyOwnership,
  83. caoCopyPermissions,
  84. caoCopyXattributes,
  85. // Modifiers
  86. caoCopyTimeEx,
  87. caoCopyAttrEx,
  88. caoRemoveReadOnlyAttr);
  89. TCopyAttributesOptions = set of TCopyAttributesOption;
  90. TCopyAttributesResult = array[TCopyAttributesOption] of Integer;
  91. PCopyAttributesResult = ^TCopyAttributesResult;
  92. const
  93. faInvalidAttributes = TFileAttrs(-1);
  94. CopyAttributesOptionCopyAll = [caoCopyAttributes, caoCopyTime, caoCopyOwnership];
  95. {en
  96. Is file a directory
  97. @param(iAttr File attributes)
  98. @returns(@true if file is a directory, @false otherwise)
  99. }
  100. function FPS_ISDIR(iAttr: TFileAttrs) : Boolean;
  101. {en
  102. Is file a symbolic link
  103. @param(iAttr File attributes)
  104. @returns(@true if file is a symbolic link, @false otherwise)
  105. }
  106. function FPS_ISLNK(iAttr: TFileAttrs) : Boolean;
  107. {en
  108. Is file a regular file
  109. @param(iAttr File attributes)
  110. @returns(@true if file is a regular file, @false otherwise)
  111. }
  112. function FPS_ISREG(iAttr: TFileAttrs) : Boolean;
  113. {en
  114. Is file executable
  115. @param(sFileName File name)
  116. @returns(@true if file is executable, @false otherwise)
  117. }
  118. function FileIsExeLib(const sFileName : String) : Boolean;
  119. {en
  120. Is file console executable
  121. @param(sFileName File name)
  122. @returns(@true if file is console executable, @false otherwise)
  123. }
  124. function FileIsConsoleExe(const FileName: String): Boolean;
  125. {en
  126. Copies a file attributes (attributes, date/time, owner & group, permissions).
  127. @param(sSrc String expression that specifies the name of the file to be copied)
  128. @param(sDst String expression that specifies the target file name)
  129. @param(bDropReadOnlyFlag Drop read only attribute if @true)
  130. @returns(The function returns @true if successful, @false otherwise)
  131. }
  132. function FileIsReadOnly(iAttr: TFileAttrs): Boolean; inline;
  133. {en
  134. Returns path to a temporary name. It ensures that returned path doesn't exist,
  135. i.e., there is no filesystem entry by that name.
  136. If it could not create a unique temporary name then it returns empty string.
  137. @param(PathPrefix
  138. This parameter is added at the beginning of each path that is tried.
  139. The directories in this path are not created if they don't exist.
  140. If it is empty then the system temporary directory is used.
  141. For example:
  142. If PathPrefix is '/tmp/myfile' then files '/tmp/myfile~XXXXXX.tmp' are tried.
  143. The path '/tmp' must already exist.)
  144. }
  145. function GetTempName(PathPrefix: String; Extension: String = 'tmp'): String;
  146. {en
  147. Find file in the system PATH
  148. }
  149. function FindInSystemPath(var FileName: String): Boolean;
  150. {en
  151. Extract file root directory
  152. @param(FileName File name)
  153. }
  154. function ExtractRootDir(const FileName: String): String;
  155. (* File mapping/unmapping routines *)
  156. {en
  157. Create memory map of a file
  158. @param(sFileName Name of file to mapping)
  159. @param(FileMapRec TFileMapRec structure)
  160. @returns(The function returns @true if successful, @false otherwise)
  161. }
  162. function MapFile(const sFileName : String; out FileMapRec : TFileMapRec) : Boolean;
  163. {en
  164. Unmap previously mapped file
  165. @param(FileMapRec TFileMapRec structure)
  166. }
  167. procedure UnMapFile(var FileMapRec : TFileMapRec);
  168. function NormalizeFileName(const Source: String): String;
  169. {en
  170. Convert from console to UTF8 encoding.
  171. }
  172. function ConsoleToUTF8(const Source: String): RawByteString;
  173. { File handling functions}
  174. function mbFileOpen(const FileName: String; Mode: LongWord): System.THandle;
  175. function mbFileCreate(const FileName: String): System.THandle; overload; inline;
  176. function mbFileCreate(const FileName: String; Mode: LongWord): System.THandle; overload; inline;
  177. function mbFileCreate(const FileName: String; Mode, Rights: LongWord): System.THandle; overload;
  178. function mbFileAge(const FileName: String): DCBasicTypes.TFileTime;
  179. function mbFileGetTime(const FileName: String): DCBasicTypes.TFileTimeEx;
  180. // On success returns True.
  181. // nanoseconds supported
  182. function mbFileGetTime(const FileName: String;
  183. var ModificationTime: DCBasicTypes.TFileTimeEx;
  184. var CreationTime : DCBasicTypes.TFileTimeEx;
  185. var LastAccessTime : DCBasicTypes.TFileTimeEx): Boolean;
  186. // On success returns True.
  187. function mbFileSetTime(const FileName: String;
  188. ModificationTime: DCBasicTypes.TFileTime;
  189. CreationTime : DCBasicTypes.TFileTime = 0;
  190. LastAccessTime : DCBasicTypes.TFileTime = 0): Boolean;
  191. // nanoseconds supported
  192. function mbFileSetTimeEx(const FileName: String;
  193. ModificationTime: DCBasicTypes.TFileTimeEx;
  194. CreationTime : DCBasicTypes.TFileTimeEx;
  195. LastAccessTime : DCBasicTypes.TFileTimeEx): Boolean;
  196. {en
  197. Checks if a given file exists - it can be a real file or a link to a file,
  198. but it can be opened and read from.
  199. Even if the result is @false, we can't be sure a file by that name can be created,
  200. because there may still exist a directory or link by that name.
  201. }
  202. function mbFileExists(const FileName: String): Boolean;
  203. function mbFileAccess(const FileName: String; Mode: Word): Boolean;
  204. function mbFileGetAttr(const FileName: String): TFileAttrs; overload;
  205. function mbFileGetAttr(const FileName: String; out Attr: TFileAttributeData): Boolean; overload;
  206. function mbFileSetAttr(const FileName: String; Attr: TFileAttrs): Boolean;
  207. {en
  208. If any operation in Options is performed and does not succeed it is included
  209. in the result set. If all performed operations succeed the function returns empty set.
  210. For example for Options=[caoCopyTime, caoCopyOwnership] setting ownership
  211. doesn't succeed then the function returns [caoCopyOwnership].
  212. }
  213. function mbFileCopyAttr(const sSrc, sDst: String;
  214. Options: TCopyAttributesOptions;
  215. Errors: PCopyAttributesResult = nil): TCopyAttributesOptions;
  216. // Returns True on success.
  217. function mbFileSetReadOnly(const FileName: String; ReadOnly: Boolean): Boolean;
  218. function mbDeleteFile(const FileName: String): Boolean;
  219. function mbRenameFile(const OldName: String; NewName: String): Boolean;
  220. function mbFileSize(const FileName: String): Int64;
  221. function FileGetSize(Handle: System.THandle): Int64;
  222. function FileFlush(Handle: System.THandle): Boolean;
  223. function FileFlushData(Handle: System.THandle): Boolean;
  224. function FileIsReadOnlyEx(Handle: System.THandle): Boolean;
  225. function FileAllocate(Handle: System.THandle; Size: Int64): Boolean;
  226. { Directory handling functions}
  227. function mbGetCurrentDir: String;
  228. function mbSetCurrentDir(const NewDir: String): Boolean;
  229. {en
  230. Checks if a given directory exists - it may be a real directory or a link to directory.
  231. Even if the result is @false, we can't be sure a directory by that name can be created,
  232. because there may still exist a file or link by that name.
  233. }
  234. function mbDirectoryExists(const Directory : String) : Boolean;
  235. function mbCreateDir(const NewDir: String): Boolean;
  236. function mbRemoveDir(const Dir: String): Boolean;
  237. {en
  238. Checks if any file system entry exists at given path.
  239. It can be file, directory, link, etc. (links are not followed).
  240. }
  241. function mbFileSystemEntryExists(const Path: String): Boolean;
  242. function mbCompareFileNames(const FileName1, FileName2: String): Boolean;
  243. function mbFileSame(const FileName1, FileName2: String): Boolean;
  244. function mbFileSameVolume(const FileName1, FileName2: String) : Boolean;
  245. { Other functions }
  246. function mbGetEnvironmentString(Index : Integer) : String;
  247. {en
  248. Expands environment-variable strings and replaces
  249. them with the values defined for the current user
  250. }
  251. function mbExpandEnvironmentStrings(const FileName: String): String;
  252. function mbGetEnvironmentVariable(const sName: String): String;
  253. function mbSetEnvironmentVariable(const sName, sValue: String): Boolean;
  254. function mbUnsetEnvironmentVariable(const sName: String): Boolean;
  255. function mbSysErrorMessage: String; overload; inline;
  256. function mbSysErrorMessage(ErrorCode: Integer): String; overload;
  257. {en
  258. Get current module name
  259. }
  260. function mbGetModuleName(Address: Pointer = nil): String;
  261. function mbLoadLibrary(const Name: String): TLibHandle;
  262. function mbLoadLibraryEx(const Name: String): TLibHandle;
  263. function SafeGetProcAddress(Lib: TLibHandle; const ProcName: AnsiString): Pointer;
  264. {en
  265. Reads the concrete file's name that the link points to.
  266. If the link points to a link then it's resolved recursively
  267. until a valid file name that is not a link is found.
  268. @param(PathToLink Name of symbolic link (absolute path))
  269. @returns(The absolute filename the symbolic link name is pointing to,
  270. or an empty string when the link is invalid or
  271. the file it points to does not exist.)
  272. }
  273. function mbReadAllLinks(const PathToLink : String) : String;
  274. {en
  275. If PathToLink points to a link then it returns file that the link points to (recursively).
  276. If PathToLink does not point to a link then PathToLink value is returned.
  277. }
  278. function mbCheckReadLinks(const PathToLink : String) : String;
  279. {en
  280. Same as mbFileGetAttr, but dereferences any encountered links.
  281. }
  282. function mbFileGetAttrNoLinks(const FileName: String): TFileAttrs;
  283. {en
  284. Create a hard link to a file
  285. @param(Path Name of file)
  286. @param(LinkName Name of hard link)
  287. @returns(The function returns @true if successful, @false otherwise)
  288. }
  289. function CreateHardLink(const Path, LinkName: String) : Boolean;
  290. {en
  291. Create a symbolic link
  292. @param(Path Name of file)
  293. @param(LinkName Name of symbolic link)
  294. @returns(The function returns @true if successful, @false otherwise)
  295. }
  296. function CreateSymLink(const Path, LinkName: string; Attr: UInt32 = faInvalidAttributes) : Boolean;
  297. {en
  298. Read destination of symbolic link
  299. @param(LinkName Name of symbolic link)
  300. @returns(The file name/path the symbolic link name is pointing to.
  301. The path may be relative to link's location.)
  302. }
  303. function ReadSymLink(const LinkName : String) : String;
  304. {en
  305. Sets the last-error code for the calling thread
  306. }
  307. procedure SetLastOSError(LastError: Integer);
  308. function GetTickCountEx: UInt64;
  309. implementation
  310. uses
  311. {$IF DEFINED(MSWINDOWS)}
  312. DCDateTimeUtils, DCWindows, DCNtfsLinks,
  313. {$ENDIF}
  314. {$IF DEFINED(UNIX)}
  315. Unix, dl,
  316. {$ENDIF}
  317. {$IF DEFINED(DARWIN)}
  318. LazFileUtils,
  319. {$ENDIF}
  320. DCStrUtils, LazUTF8;
  321. {$IFDEF UNIX}
  322. function SetModeReadOnly(mode: TMode; ReadOnly: Boolean): TMode;
  323. begin
  324. mode := mode and not (S_IWUSR or S_IWGRP or S_IWOTH);
  325. if ReadOnly = False then
  326. begin
  327. if (mode AND S_IRUSR) = S_IRUSR then
  328. mode := mode or S_IWUSR;
  329. if (mode AND S_IRGRP) = S_IRGRP then
  330. mode := mode or S_IWGRP;
  331. if (mode AND S_IROTH) = S_IROTH then
  332. mode := mode or S_IWOTH;
  333. end;
  334. Result := mode;
  335. end;
  336. {$ENDIF}
  337. {$IF DEFINED(MSWINDOWS)}
  338. const
  339. AccessModes: array[0..2] of DWORD = (
  340. GENERIC_READ,
  341. GENERIC_WRITE,
  342. GENERIC_READ or GENERIC_WRITE);
  343. ShareModes: array[0..4] of DWORD = (
  344. 0,
  345. 0,
  346. FILE_SHARE_READ,
  347. FILE_SHARE_WRITE,
  348. FILE_SHARE_READ or FILE_SHARE_WRITE or FILE_SHARE_DELETE);
  349. OpenFlags: array[0..3] of DWORD = (
  350. 0,
  351. FILE_FLAG_WRITE_THROUGH,
  352. FILE_FLAG_NO_BUFFERING,
  353. FILE_FLAG_WRITE_THROUGH or FILE_FLAG_NO_BUFFERING);
  354. var
  355. CurrentDirectory: String;
  356. PerformanceFrequency: LARGE_INTEGER;
  357. {$ELSEIF DEFINED(UNIX)}
  358. const
  359. {$IF NOT DECLARED(O_SYNC)}
  360. O_SYNC = 0;
  361. {$ENDIF}
  362. {$IF NOT DECLARED(O_DIRECT)}
  363. O_DIRECT = 0;
  364. {$ENDIF}
  365. AccessModes: array[0..2] of cInt = (
  366. O_RdOnly,
  367. O_WrOnly,
  368. O_RdWr);
  369. OpenFlags: array[0..3] of cInt = (
  370. 0,
  371. O_SYNC,
  372. O_DIRECT,
  373. O_SYNC or O_DIRECT);
  374. {$ENDIF}
  375. function FPS_ISDIR(iAttr: TFileAttrs) : Boolean; inline;
  376. {$IFDEF MSWINDOWS}
  377. begin
  378. Result := (iAttr and FILE_ATTRIBUTE_DIRECTORY <> 0);
  379. end;
  380. {$ELSE}
  381. begin
  382. Result := BaseUnix.FPS_ISDIR(TMode(iAttr));
  383. end;
  384. {$ENDIF}
  385. function FPS_ISLNK(iAttr: TFileAttrs) : Boolean; inline;
  386. {$IFDEF MSWINDOWS}
  387. begin
  388. Result := (iAttr and FILE_ATTRIBUTE_REPARSE_POINT <> 0);
  389. end;
  390. {$ELSE}
  391. begin
  392. Result := BaseUnix.FPS_ISLNK(TMode(iAttr));
  393. end;
  394. {$ENDIF}
  395. function FPS_ISREG(iAttr: TFileAttrs) : Boolean; inline;
  396. {$IFDEF MSWINDOWS}
  397. begin
  398. Result := (iAttr and FILE_ATTRIBUTE_DIRECTORY = 0);
  399. end;
  400. {$ELSE}
  401. begin
  402. Result := BaseUnix.FPS_ISREG(TMode(iAttr));
  403. end;
  404. {$ENDIF}
  405. function FileIsExeLib(const sFileName : String) : Boolean;
  406. var
  407. fsExeLib : TFileStreamEx;
  408. {$IFDEF MSWINDOWS}
  409. Sign : Word;
  410. {$ELSE}
  411. Sign : DWord;
  412. {$ENDIF}
  413. begin
  414. Result := False;
  415. if mbFileExists(sFileName) and (mbFileSize(sFileName) >= SizeOf(Sign)) then
  416. try
  417. fsExeLib := TFileStreamEx.Create(sFileName, fmOpenRead or fmShareDenyNone);
  418. try
  419. {$IFDEF MSWINDOWS}
  420. Sign := fsExeLib.ReadWord;
  421. Result := (Sign = $5A4D);
  422. {$ELSE}
  423. Sign := fsExeLib.ReadDWord;
  424. Result := (Sign = $464C457F);
  425. {$ENDIF}
  426. finally
  427. fsExeLib.Free;
  428. end;
  429. except
  430. Result := False;
  431. end;
  432. end;
  433. function FileIsConsoleExe(const FileName: String): Boolean;
  434. {$IF DEFINED(UNIX)}
  435. begin
  436. Result:= True;
  437. end;
  438. {$ELSE}
  439. var
  440. fsFileStream: TFileStreamEx;
  441. begin
  442. Result:= False;
  443. try
  444. fsFileStream:= TFileStreamEx.Create(FileName, fmOpenRead or fmShareDenyNone);
  445. try
  446. if fsFileStream.ReadWord = IMAGE_DOS_SIGNATURE then
  447. begin
  448. fsFileStream.Seek(60, soBeginning);
  449. fsFileStream.Seek(fsFileStream.ReadDWord, soBeginning);
  450. if fsFileStream.ReadDWord = IMAGE_NT_SIGNATURE then
  451. begin
  452. fsFileStream.Seek(88, soCurrent);
  453. Result:= (fsFileStream.ReadWord = IMAGE_SUBSYSTEM_WINDOWS_CUI);
  454. end;
  455. end;
  456. finally
  457. fsFileStream.Free;
  458. end;
  459. except
  460. Result:= False;
  461. end;
  462. end;
  463. {$ENDIF}
  464. function FileIsReadOnly(iAttr: TFileAttrs): Boolean;
  465. {$IFDEF MSWINDOWS}
  466. begin
  467. Result:= (iAttr and (faReadOnly or faHidden or faSysFile)) <> 0;
  468. end;
  469. {$ELSE}
  470. begin
  471. Result:= (((iAttr AND S_IRUSR) = S_IRUSR) and ((iAttr AND S_IWUSR) <> S_IWUSR));
  472. end;
  473. {$ENDIF}
  474. function mbFileCopyAttr(const sSrc, sDst: String;
  475. Options: TCopyAttributesOptions; Errors: PCopyAttributesResult
  476. ): TCopyAttributesOptions;
  477. {$IFDEF MSWINDOWS}
  478. var
  479. Attr: TWin32FileAttributeData;
  480. Option: TCopyAttributesOption;
  481. ModificationTime, CreationTime, LastAccessTime: DCBasicTypes.TFileTime;
  482. begin
  483. Result := [];
  484. if not GetFileAttributesExW(PWideChar(UTF16LongName(sSrc)), GetFileExInfoStandard, @Attr) then
  485. begin
  486. Result := Options;
  487. if Assigned(Errors) then
  488. begin
  489. for Option in Result do
  490. Errors^[Option]:= GetLastOSError;
  491. end;
  492. Exit;
  493. end;
  494. if [caoCopyAttributes, caoCopyAttrEx] * Options <> [] then
  495. begin
  496. if (not (caoCopyAttributes in Options)) and (Attr.dwFileAttributes and faDirectory = 0) then
  497. Attr.dwFileAttributes := (Attr.dwFileAttributes or faArchive);
  498. if (caoRemoveReadOnlyAttr in Options) and ((Attr.dwFileAttributes and faReadOnly) <> 0) then
  499. Attr.dwFileAttributes := (Attr.dwFileAttributes and not faReadOnly);
  500. if not mbFileSetAttr(sDst, Attr.dwFileAttributes) then
  501. begin
  502. Include(Result, caoCopyAttributes);
  503. if Assigned(Errors) then Errors^[caoCopyAttributes]:= GetLastOSError;
  504. end;
  505. end;
  506. if not FPS_ISLNK(Attr.dwFileAttributes) then
  507. begin
  508. if (caoCopyXattributes in Options) then
  509. begin
  510. if not mbFileCopyXattr(sSrc, sDst) then
  511. begin
  512. Include(Result, caoCopyXattributes);
  513. if Assigned(Errors) then Errors^[caoCopyXattributes]:= GetLastOSError;
  514. end;
  515. end;
  516. if ([caoCopyTime, caoCopyTimeEx] * Options <> []) then
  517. begin
  518. if not (caoCopyTime in Options) then
  519. begin
  520. CreationTime:= 0;
  521. LastAccessTime:= 0;
  522. end
  523. else begin
  524. CreationTime:= DCBasicTypes.TFileTime(Attr.ftCreationTime);
  525. LastAccessTime:= DCBasicTypes.TFileTime(Attr.ftLastAccessTime);
  526. end;
  527. ModificationTime:= DCBasicTypes.TFileTime(Attr.ftLastWriteTime);
  528. if not mbFileSetTime(sDst, ModificationTime, CreationTime, LastAccessTime) then
  529. begin
  530. Include(Result, caoCopyTime);
  531. if Assigned(Errors) then Errors^[caoCopyTime]:= GetLastOSError;
  532. end;
  533. end;
  534. end;
  535. if caoCopyPermissions in Options then
  536. begin
  537. if not CopyNtfsPermissions(sSrc, sDst) then
  538. begin
  539. Include(Result, caoCopyPermissions);
  540. if Assigned(Errors) then Errors^[caoCopyPermissions]:= GetLastOSError;
  541. end;
  542. end;
  543. end;
  544. {$ELSE} // *nix
  545. var
  546. Option: TCopyAttributesOption;
  547. StatInfo : TDCStat;
  548. modificationTime: TFileTimeEx;
  549. creationTime: TFileTimeEx;
  550. lastAccessTime: TFileTimeEx;
  551. mode : TMode;
  552. begin
  553. if DC_fpLStat(UTF8ToSys(sSrc), StatInfo) < 0 then
  554. begin
  555. Result := Options;
  556. if Assigned(Errors) then
  557. begin
  558. for Option in Result do
  559. Errors^[Option]:= GetLastOSError;
  560. end;
  561. end
  562. else begin
  563. Result := [];
  564. if FPS_ISLNK(StatInfo.st_mode) then
  565. begin
  566. if caoCopyOwnership in Options then
  567. begin
  568. // Only group/owner can be set for links.
  569. if fpLChown(sDst, StatInfo.st_uid, StatInfo.st_gid) = -1 then
  570. begin
  571. Include(Result, caoCopyOwnership);
  572. if Assigned(Errors) then Errors^[caoCopyOwnership]:= GetLastOSError;
  573. end;
  574. end;
  575. {$IF DEFINED(HAIKU)}
  576. if caoCopyXattributes in Options then
  577. begin
  578. if not mbFileCopyXattr(sSrc, sDst) then
  579. begin
  580. Include(Result, caoCopyXattributes);
  581. if Assigned(Errors) then Errors^[caoCopyXattributes]:= GetLastOSError;
  582. end;
  583. end;
  584. {$ENDIF}
  585. end
  586. else
  587. begin
  588. if caoCopyTime in Options then
  589. begin
  590. modificationTime:= StatInfo.mtime;
  591. lastAccessTime:= StatInfo.atime;
  592. creationTime:= StatInfo.birthtime;
  593. if DC_FileSetTime(sDst, modificationTime, creationTime, lastAccessTime) = false then
  594. begin
  595. Include(Result, caoCopyTime);
  596. if Assigned(Errors) then Errors^[caoCopyTime]:= GetLastOSError;
  597. end;
  598. end;
  599. if caoCopyOwnership in Options then
  600. begin
  601. if fpChown(PChar(UTF8ToSys(sDst)), StatInfo.st_uid, StatInfo.st_gid) = -1 then
  602. begin
  603. Include(Result, caoCopyOwnership);
  604. if Assigned(Errors) then Errors^[caoCopyOwnership]:= GetLastOSError;
  605. end;
  606. end;
  607. if caoCopyAttributes in Options then
  608. begin
  609. mode := StatInfo.st_mode;
  610. if caoRemoveReadOnlyAttr in Options then
  611. mode := SetModeReadOnly(mode, False);
  612. if fpChmod(UTF8ToSys(sDst), mode) = -1 then
  613. begin
  614. Include(Result, caoCopyAttributes);
  615. if Assigned(Errors) then Errors^[caoCopyAttributes]:= GetLastOSError;
  616. end;
  617. end;
  618. {$IF DEFINED(LINUX) or DEFINED(DARWIN) or DEFINED(HAIKU)}
  619. if caoCopyXattributes in Options then
  620. begin
  621. if not mbFileCopyXattr(sSrc, sDst) then
  622. begin
  623. Include(Result, caoCopyXattributes);
  624. if Assigned(Errors) then Errors^[caoCopyXattributes]:= GetLastOSError;
  625. end;
  626. end;
  627. {$ENDIF}
  628. end;
  629. end;
  630. end;
  631. {$ENDIF}
  632. function GetTempName(PathPrefix: String; Extension: String): String;
  633. const
  634. MaxTries = 100;
  635. var
  636. FileName: String;
  637. TryNumber: Integer = 0;
  638. begin
  639. if PathPrefix = '' then
  640. PathPrefix := GetTempDir
  641. else begin
  642. FileName:= ExtractOnlyFileName(PathPrefix);
  643. PathPrefix:= ExtractFilePath(PathPrefix);
  644. // Generated file name should be less the maximum file name length
  645. if (Length(FileName) > 0) then PathPrefix += UTF8Copy(FileName, 1, 48) + '~';
  646. end;
  647. if (Length(Extension) > 0) then
  648. begin
  649. if (not StrBegins(Extension, ExtensionSeparator)) then
  650. Extension := ExtensionSeparator + Extension;
  651. end;
  652. repeat
  653. Result := PathPrefix + IntToStr(System.Random(MaxInt)) + Extension;
  654. Inc(TryNumber);
  655. if TryNumber = MaxTries then
  656. Exit('');
  657. until not mbFileSystemEntryExists(Result);
  658. end;
  659. function FindInSystemPath(var FileName: String): Boolean;
  660. var
  661. I: Integer;
  662. Path, FullName: String;
  663. Value: TDynamicStringArray;
  664. begin
  665. Path:= mbGetEnvironmentVariable('PATH');
  666. Value:= SplitString(Path, PathSeparator);
  667. for I:= Low(Value) to High(Value) do
  668. begin
  669. FullName:= IncludeTrailingPathDelimiter(Value[I]) + FileName;
  670. if mbFileExists(FullName) then
  671. begin
  672. FileName:= FullName;
  673. Exit(True);
  674. end;
  675. end;
  676. Result:= False;
  677. end;
  678. function ExtractRootDir(const FileName: String): String;
  679. {$IFDEF UNIX}
  680. begin
  681. Result:= ExcludeTrailingPathDelimiter(FindMountPointPath(ExcludeTrailingPathDelimiter(FileName)));
  682. end;
  683. {$ELSE}
  684. begin
  685. Result:= ExtractFileDrive(FileName);
  686. end;
  687. {$ENDIF}
  688. function MapFile(const sFileName : String; out FileMapRec : TFileMapRec) : Boolean;
  689. {$IFDEF MSWINDOWS}
  690. begin
  691. Result := False;
  692. with FileMapRec do
  693. begin
  694. MappedFile := nil;
  695. MappingHandle := 0;
  696. FileHandle := mbFileOpen(sFileName, fmOpenRead);
  697. if FileHandle = feInvalidHandle then Exit;
  698. Int64Rec(FileSize).Lo := GetFileSize(FileHandle, @Int64Rec(FileSize).Hi);
  699. if FileSize = 0 then // Cannot map empty files
  700. begin
  701. UnMapFile(FileMapRec);
  702. Exit;
  703. end;
  704. MappingHandle := CreateFileMapping(FileHandle, nil, PAGE_READONLY, 0, 0, nil);
  705. if MappingHandle = 0 then
  706. begin
  707. UnMapFile(FileMapRec);
  708. Exit;
  709. end;
  710. MappedFile := MapViewOfFile(MappingHandle, FILE_MAP_READ, 0, 0, 0);
  711. if not Assigned(MappedFile) then
  712. begin
  713. UnMapFile(FileMapRec);
  714. Exit;
  715. end;
  716. end;
  717. Result := True;
  718. end;
  719. {$ELSE}
  720. var
  721. StatInfo: BaseUnix.Stat;
  722. begin
  723. Result:= False;
  724. with FileMapRec do
  725. begin
  726. MappedFile := nil;
  727. FileHandle:= mbFileOpen(sFileName, fmOpenRead);
  728. if FileHandle = feInvalidHandle then Exit;
  729. if fpfstat(FileHandle, StatInfo) <> 0 then
  730. begin
  731. UnMapFile(FileMapRec);
  732. Exit;
  733. end;
  734. FileSize := StatInfo.st_size;
  735. if FileSize = 0 then // Cannot map empty files
  736. begin
  737. UnMapFile(FileMapRec);
  738. Exit;
  739. end;
  740. MappedFile:= fpmmap(nil,FileSize,PROT_READ, MAP_PRIVATE{SHARED},FileHandle,0 );
  741. if MappedFile = MAP_FAILED then
  742. begin
  743. MappedFile := nil;
  744. UnMapFile(FileMapRec);
  745. Exit;
  746. end;
  747. end;
  748. Result := True;
  749. end;
  750. {$ENDIF}
  751. procedure UnMapFile(var FileMapRec : TFileMapRec);
  752. {$IFDEF MSWINDOWS}
  753. begin
  754. with FileMapRec do
  755. begin
  756. if Assigned(MappedFile) then
  757. begin
  758. UnmapViewOfFile(MappedFile);
  759. MappedFile := nil;
  760. end;
  761. if MappingHandle <> 0 then
  762. begin
  763. CloseHandle(MappingHandle);
  764. MappingHandle := 0;
  765. end;
  766. if FileHandle <> feInvalidHandle then
  767. begin
  768. FileClose(FileHandle);
  769. FileHandle := feInvalidHandle;
  770. end;
  771. end;
  772. end;
  773. {$ELSE}
  774. begin
  775. with FileMapRec do
  776. begin
  777. if FileHandle <> feInvalidHandle then
  778. begin
  779. fpClose(FileHandle);
  780. FileHandle := feInvalidHandle;
  781. end;
  782. if Assigned(MappedFile) then
  783. begin
  784. fpmunmap(MappedFile,FileSize);
  785. MappedFile := nil;
  786. end;
  787. end;
  788. end;
  789. {$ENDIF}
  790. function NormalizeFileName(const Source: String): String; inline;
  791. {$IF DEFINED(DARWIN)}
  792. begin
  793. Result:= GetDarwinNormalizedFileName(Source);
  794. end;
  795. {$ELSE}
  796. begin
  797. Result:= Source;
  798. end;
  799. {$ENDIF}
  800. function ConsoleToUTF8(const Source: String): RawByteString;
  801. {$IFDEF MSWINDOWS}
  802. begin
  803. Result:= CeOemToUtf8(Source);
  804. end;
  805. {$ELSE}
  806. begin
  807. Result:= CeSysToUtf8(Source);
  808. end;
  809. {$ENDIF}
  810. function mbFileOpen(const FileName: String; Mode: LongWord): System.THandle;
  811. {$IFDEF MSWINDOWS}
  812. const
  813. ft: TFileTime = ( dwLowDateTime: $FFFFFFFF; dwHighDateTime: $FFFFFFFF; );
  814. begin
  815. Result:= CreateFileW(PWideChar(UTF16LongName(FileName)),
  816. AccessModes[Mode and 3] or ((Mode and fmOpenNoATime) shr 10),
  817. ShareModes[(Mode and $F0) shr 4], nil, OPEN_EXISTING,
  818. FILE_ATTRIBUTE_NORMAL, OpenFlags[(Mode shr 16) and 3]);
  819. if (Mode and fmOpenNoATime <> 0) then
  820. begin
  821. if (Result <> feInvalidHandle) then
  822. SetFileTime(Result, nil, @ft, nil)
  823. else if GetLastError = ERROR_ACCESS_DENIED then
  824. Result := mbFileOpen(FileName, Mode and not fmOpenNoATime);
  825. end;
  826. end;
  827. {$ELSE}
  828. var
  829. Info: BaseUnix.Stat;
  830. begin
  831. repeat
  832. Result:= fpOpen(UTF8ToSys(FileName), AccessModes[Mode and 3] or
  833. OpenFlags[(Mode shr 16) and 3] or O_CLOEXEC);
  834. until (Result <> -1) or (fpgeterrno <> ESysEINTR);
  835. if Result <> feInvalidHandle then
  836. begin
  837. FileCloseOnExec(Result);
  838. if (Mode and fmOpenSpecial = 0) then
  839. begin
  840. if fpFStat(Result, Info) = 0 then
  841. begin
  842. if FPS_ISFIFO(Info.st_mode) then
  843. begin
  844. FileClose(Result);
  845. errno:= ESysEINVAL;
  846. Exit(feInvalidHandle);
  847. end;
  848. end;
  849. end;
  850. {$IF DEFINED(DARWIN)}
  851. if (Mode and (fmOpenSync or fmOpenDirect) <> 0) then
  852. begin
  853. if (FpFcntl(Result, F_NOCACHE, 1) = -1) then
  854. begin
  855. FileClose(Result);
  856. Exit(feInvalidHandle);
  857. end;
  858. end;
  859. {$ENDIF}
  860. end;
  861. end;
  862. {$ENDIF}
  863. function mbFileCreate(const FileName: String): System.THandle;
  864. begin
  865. Result:= mbFileCreate(FileName, fmShareDenyWrite);
  866. end;
  867. function mbFileCreate(const FileName: String; Mode: LongWord): System.THandle;
  868. begin
  869. Result:= mbFileCreate(FileName, Mode, 438); // 438 = 666 octal
  870. end;
  871. function mbFileCreate(const FileName: String; Mode, Rights: LongWord): System.THandle;
  872. {$IFDEF MSWINDOWS}
  873. begin
  874. Result:= CreateFileW(PWideChar(UTF16LongName(FileName)), GENERIC_READ or GENERIC_WRITE,
  875. ShareModes[(Mode and $F0) shr 4], nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL,
  876. OpenFlags[(Mode shr 16) and 3]);
  877. end;
  878. {$ELSE}
  879. begin
  880. repeat
  881. Result:= fpOpen(UTF8ToSys(FileName), O_Creat or O_RdWr or O_Trunc or
  882. OpenFlags[(Mode shr 16) and 3] or O_CLOEXEC, Rights);
  883. until (Result <> -1) or (fpgeterrno <> ESysEINTR);
  884. if Result <> feInvalidHandle then
  885. begin
  886. FileCloseOnExec(Result);
  887. {$IF DEFINED(DARWIN)}
  888. if (Mode and (fmOpenSync or fmOpenDirect) <> 0) then
  889. begin
  890. if (FpFcntl(Result, F_NOCACHE, 1) = -1) then
  891. begin
  892. FileClose(Result);
  893. Exit(feInvalidHandle);
  894. end;
  895. end;
  896. {$ENDIF}
  897. end;
  898. end;
  899. {$ENDIF}
  900. function mbFileAge(const FileName: String): DCBasicTypes.TFileTime;
  901. {$IFDEF MSWINDOWS}
  902. var
  903. Handle: System.THandle;
  904. FindData: TWin32FindDataW;
  905. begin
  906. Handle:= FindFirstFileW(PWideChar(UTF16LongName(FileName)), FindData);
  907. if Handle <> INVALID_HANDLE_VALUE then
  908. begin
  909. Windows.FindClose(Handle);
  910. Exit(DCBasicTypes.TFileTime(FindData.ftLastWriteTime));
  911. end;
  912. Result:= DCBasicTypes.TFileTime(-1);
  913. end;
  914. {$ELSE}
  915. var
  916. Info: BaseUnix.Stat;
  917. begin
  918. if fpStat(UTF8ToSys(FileName), Info) >= 0 then
  919. Result:= DCBasicTypes.TFileTime(Info.st_mtime)
  920. else begin
  921. Result:= DCBasicTypes.TFileTime(-1);
  922. end;
  923. end;
  924. {$ENDIF}
  925. function mbFileGetTime(const FileName: String): DCBasicTypes.TFileTimeEx;
  926. var
  927. CreationTime, LastAccessTime: DCBasicTypes.TFileTimeEx;
  928. begin
  929. if not mbFileGetTime(FileName, Result, CreationTime, LastAccessTime) then
  930. Result:= TFileTimeExNull;
  931. end;
  932. function mbFileGetTime(const FileName: String;
  933. var ModificationTime: DCBasicTypes.TFileTimeEx;
  934. var CreationTime : DCBasicTypes.TFileTimeEx;
  935. var LastAccessTime : DCBasicTypes.TFileTimeEx): Boolean;
  936. {$IFDEF MSWINDOWS}
  937. var
  938. Handle: System.THandle;
  939. begin
  940. Handle := CreateFileW(PWideChar(UTF16LongName(FileName)),
  941. FILE_READ_ATTRIBUTES,
  942. FILE_SHARE_READ or FILE_SHARE_WRITE or FILE_SHARE_DELETE,
  943. nil,
  944. OPEN_EXISTING,
  945. FILE_FLAG_BACKUP_SEMANTICS, // needed for opening directories
  946. 0);
  947. if Handle <> INVALID_HANDLE_VALUE then
  948. begin
  949. Result := Windows.GetFileTime(Handle,
  950. @CreationTime,
  951. @LastAccessTime,
  952. @ModificationTime);
  953. CloseHandle(Handle);
  954. end
  955. else
  956. Result := False;
  957. end;
  958. {$ELSE}
  959. var
  960. StatInfo : TDCStat;
  961. begin
  962. Result := DC_fpLStat(UTF8ToSys(FileName), StatInfo) >= 0;
  963. if Result then
  964. begin
  965. ModificationTime:= StatInfo.mtime;
  966. LastAccessTime:= StatInfo.atime;
  967. {$IF DEFINED(DARWIN)}
  968. CreationTime:= StatInfo.birthtime;
  969. {$ELSE}
  970. CreationTime:= StatInfo.ctime;
  971. {$ENDIF}
  972. end;
  973. end;
  974. {$ENDIF}
  975. function mbFileSetTime(const FileName: String;
  976. ModificationTime: DCBasicTypes.TFileTime;
  977. CreationTime : DCBasicTypes.TFileTime = 0;
  978. LastAccessTime : DCBasicTypes.TFileTime = 0): Boolean;
  979. {$IFDEF MSWINDOWS}
  980. begin
  981. Result:= mbFileSetTimeEx(FileName, ModificationTime, CreationTime, LastAccessTime);
  982. end;
  983. {$ELSE}
  984. var
  985. NewModificationTime: DCBasicTypes.TFileTimeEx;
  986. NewCreationTime : DCBasicTypes.TFileTimeEx;
  987. NewLastAccessTime : DCBasicTypes.TFileTimeEx;
  988. begin
  989. NewModificationTime:= specialize IfThen<TFileTimeEx>(ModificationTime<>0, TFileTimeEx.create(ModificationTime), TFileTimeExNull);
  990. NewCreationTime:= specialize IfThen<TFileTimeEx>(CreationTime<>0, TFileTimeEx.create(CreationTime), TFileTimeExNull);
  991. NewLastAccessTime:= specialize IfThen<TFileTimeEx>(LastAccessTime<>0, TFileTimeEx.create(LastAccessTime), TFileTimeExNull);
  992. Result:= mbFileSetTimeEx(FileName, NewModificationTime, NewCreationTime, NewLastAccessTime);
  993. end;
  994. {$ENDIF}
  995. function mbFileSetTimeEx(const FileName: String;
  996. ModificationTime: DCBasicTypes.TFileTimeEx;
  997. CreationTime : DCBasicTypes.TFileTimeEx;
  998. LastAccessTime : DCBasicTypes.TFileTimeEx): Boolean;
  999. {$IFDEF MSWINDOWS}
  1000. var
  1001. Handle: System.THandle;
  1002. PWinModificationTime: Windows.LPFILETIME = nil;
  1003. PWinCreationTime: Windows.LPFILETIME = nil;
  1004. PWinLastAccessTime: Windows.LPFILETIME = nil;
  1005. begin
  1006. Handle := CreateFileW(PWideChar(UTF16LongName(FileName)),
  1007. FILE_WRITE_ATTRIBUTES,
  1008. FILE_SHARE_READ or FILE_SHARE_WRITE or FILE_SHARE_DELETE,
  1009. nil,
  1010. OPEN_EXISTING,
  1011. FILE_FLAG_BACKUP_SEMANTICS, // needed for opening directories
  1012. 0);
  1013. if Handle <> INVALID_HANDLE_VALUE then
  1014. begin
  1015. if ModificationTime <> 0 then
  1016. begin
  1017. PWinModificationTime := @ModificationTime;
  1018. end;
  1019. if CreationTime <> 0 then
  1020. begin
  1021. PWinCreationTime := @CreationTime;
  1022. end;
  1023. if LastAccessTime <> 0 then
  1024. begin
  1025. PWinLastAccessTime := @LastAccessTime;
  1026. end;
  1027. Result := Windows.SetFileTime(Handle,
  1028. PWinCreationTime,
  1029. PWinLastAccessTime,
  1030. PWinModificationTime);
  1031. CloseHandle(Handle);
  1032. end
  1033. else
  1034. Result := False;
  1035. end;
  1036. {$ELSE}
  1037. var
  1038. CurrentModificationTime, CurrentCreationTime, CurrentLastAccessTime: DCBasicTypes.TFileTimeEx;
  1039. begin
  1040. if mbFileGetTime(FileName, CurrentModificationTime, CurrentCreationTime, CurrentLastAccessTime) then
  1041. begin
  1042. if ModificationTime<>TFileTimeExNull then CurrentModificationTime:= ModificationTime;
  1043. if CreationTime<>TFileTimeExNull then CurrentCreationTime:= CreationTime;
  1044. if LastAccessTime<>TFileTimeExNull then CurrentLastAccessTime:= LastAccessTime;
  1045. Result := DC_FileSetTime(FileName, CurrentModificationTime, CurrentCreationTime, CurrentLastAccessTime);
  1046. end
  1047. else
  1048. begin
  1049. Result:=False;
  1050. end;
  1051. end;
  1052. {$ENDIF}
  1053. function mbFileExists(const FileName: String) : Boolean;
  1054. {$IFDEF MSWINDOWS}
  1055. var
  1056. Attr: DWORD;
  1057. begin
  1058. Attr:= GetFileAttributesW(PWideChar(UTF16LongName(FileName)));
  1059. if Attr <> DWORD(-1) then
  1060. Result:= (Attr and FILE_ATTRIBUTE_DIRECTORY) = 0
  1061. else
  1062. Result:=False;
  1063. end;
  1064. {$ELSE}
  1065. var
  1066. Info: BaseUnix.Stat;
  1067. begin
  1068. // Can use fpStat, because link to an existing filename can be opened as if it were a real file.
  1069. if fpStat(UTF8ToSys(FileName), Info) >= 0 then
  1070. Result:= fpS_ISREG(Info.st_mode)
  1071. else
  1072. Result:= False;
  1073. end;
  1074. {$ENDIF}
  1075. function mbFileAccess(const FileName: String; Mode: Word): Boolean;
  1076. {$IFDEF MSWINDOWS}
  1077. const
  1078. AccessMode: array[0..2] of DWORD = (
  1079. GENERIC_READ,
  1080. GENERIC_WRITE,
  1081. GENERIC_READ or GENERIC_WRITE);
  1082. var
  1083. hFile: System.THandle;
  1084. dwDesiredAccess: DWORD;
  1085. dwShareMode: DWORD = 0;
  1086. begin
  1087. dwDesiredAccess := AccessMode[Mode and 3];
  1088. if Mode = fmOpenRead then // If checking Read mode no sharing mode given
  1089. Mode := Mode or fmShareDenyNone;
  1090. dwShareMode := ShareModes[(Mode and $F0) shr 4];
  1091. hFile:= CreateFileW(PWideChar(UTF16LongName(FileName)), dwDesiredAccess, dwShareMode,
  1092. nil, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, 0);
  1093. Result := hFile <> INVALID_HANDLE_VALUE;
  1094. if Result then
  1095. FileClose(hFile);
  1096. end;
  1097. {$ELSE}
  1098. const
  1099. AccessMode: array[0..2] of LongInt = (
  1100. R_OK,
  1101. W_OK,
  1102. R_OK or W_OK);
  1103. begin
  1104. Result:= fpAccess(UTF8ToSys(FileName), AccessMode[Mode and 3]) = 0;
  1105. end;
  1106. {$ENDIF}
  1107. {$IFOPT R+}
  1108. {$DEFINE uOSUtilsRangeCheckOn}
  1109. {$R-}
  1110. {$ENDIF}
  1111. function mbFileGetAttr(const FileName: String): TFileAttrs;
  1112. {$IFDEF MSWINDOWS}
  1113. begin
  1114. Result := GetFileAttributesW(PWideChar(UTF16LongName(FileName)));
  1115. end;
  1116. {$ELSE}
  1117. var
  1118. Info: BaseUnix.Stat;
  1119. begin
  1120. if fpLStat(UTF8ToSys(FileName), @Info) >= 0 then
  1121. Result:= Info.st_mode
  1122. else
  1123. Result:= faInvalidAttributes;
  1124. end;
  1125. {$ENDIF}
  1126. function mbFileGetAttr(const FileName: String; out Attr: TFileAttributeData): Boolean;
  1127. {$IFDEF MSWINDOWS}
  1128. var
  1129. Handle: THandle;
  1130. fInfoLevelId: FINDEX_INFO_LEVELS;
  1131. FileInfo: Windows.TWin32FindDataW;
  1132. begin
  1133. if CheckWin32Version(6, 1) then
  1134. fInfoLevelId:= FindExInfoBasic
  1135. else begin
  1136. fInfoLevelId:= FindExInfoStandard;
  1137. end;
  1138. Handle:= FindFirstFileExW(PWideChar(UTF16LongName(FileName)), fInfoLevelId,
  1139. @FileInfo, FindExSearchNameMatch, nil, 0);
  1140. Result:= Handle <> INVALID_HANDLE_VALUE;
  1141. if Result then
  1142. begin
  1143. FindClose(Handle);
  1144. // If a reparse point tag is not a name surrogate then remove reparse point attribute
  1145. // Fixes bug: http://doublecmd.sourceforge.net/mantisbt/view.php?id=531
  1146. if (FileInfo.dwFileAttributes and FILE_ATTRIBUTE_REPARSE_POINT <> 0) then
  1147. begin
  1148. if (FileInfo.dwReserved0 and $20000000 = 0) then
  1149. FileInfo.dwFileAttributes-= FILE_ATTRIBUTE_REPARSE_POINT;
  1150. end;
  1151. Int64Rec(Attr.Size).Lo:= FileInfo.nFileSizeLow;
  1152. Int64Rec(Attr.Size).Hi:= FileInfo.nFileSizeHigh;
  1153. Move(FileInfo, Attr.FindData, SizeOf(TWin32FileAttributeData));
  1154. end;
  1155. end;
  1156. {$ELSE}
  1157. begin
  1158. Result:= fpLStat(UTF8ToSys(FileName), Attr.FindData) >= 0;
  1159. if Result then
  1160. begin
  1161. Attr.Size:= Attr.FindData.st_size;
  1162. end;
  1163. end;
  1164. {$ENDIF}
  1165. function mbFileSetAttr(const FileName: String; Attr: TFileAttrs): Boolean;
  1166. {$IFDEF MSWINDOWS}
  1167. begin
  1168. Result:= SetFileAttributesW(PWideChar(UTF16LongName(FileName)), Attr);
  1169. end;
  1170. {$ELSE}
  1171. begin
  1172. Result:= fpchmod(UTF8ToSys(FileName), Attr) = 0;
  1173. end;
  1174. {$ENDIF}
  1175. {$IFDEF uOSUtilsRangeCheckOn}
  1176. {$R+}
  1177. {$UNDEF uOSUtilsRangeCheckOn}
  1178. {$ENDIF}
  1179. function mbFileSetReadOnly(const FileName: String; ReadOnly: Boolean): Boolean;
  1180. {$IFDEF MSWINDOWS}
  1181. var
  1182. iAttr: DWORD;
  1183. wFileName: UnicodeString;
  1184. begin
  1185. wFileName:= UTF16LongName(FileName);
  1186. iAttr := GetFileAttributesW(PWideChar(wFileName));
  1187. if iAttr = DWORD(-1) then Exit(False);
  1188. if ReadOnly then
  1189. iAttr:= iAttr or faReadOnly
  1190. else
  1191. iAttr:= iAttr and not (faReadOnly or faHidden or faSysFile);
  1192. Result:= SetFileAttributesW(PWideChar(wFileName), iAttr) = True;
  1193. end;
  1194. {$ELSE}
  1195. var
  1196. StatInfo: BaseUnix.Stat;
  1197. mode: TMode;
  1198. begin
  1199. if fpStat(UTF8ToSys(FileName), StatInfo) <> 0 then Exit(False);
  1200. mode := SetModeReadOnly(StatInfo.st_mode, ReadOnly);
  1201. Result:= fpchmod(UTF8ToSys(FileName), mode) = 0;
  1202. end;
  1203. {$ENDIF}
  1204. function mbDeleteFile(const FileName: String): Boolean;
  1205. {$IFDEF MSWINDOWS}
  1206. begin
  1207. Result:= Windows.DeleteFileW(PWideChar(UTF16LongName(FileName)));
  1208. if not Result then Result:= (GetLastError = ERROR_FILE_NOT_FOUND);
  1209. end;
  1210. {$ELSE}
  1211. begin
  1212. Result:= fpUnLink(UTF8ToSys(FileName)) = 0;
  1213. if not Result then Result:= (fpgetErrNo = ESysENOENT);
  1214. end;
  1215. {$ENDIF}
  1216. function mbRenameFile(const OldName: String; NewName: String): Boolean;
  1217. {$IFDEF MSWINDOWS}
  1218. var
  1219. wTmpName,
  1220. wOldName, wNewName: UnicodeString;
  1221. begin
  1222. wNewName:= UTF16LongName(NewName);
  1223. wOldName:= UTF16LongName(OldName);
  1224. // Workaround: Windows >= 10 can't change only filename case on the FAT
  1225. if (Win32MajorVersion >= 10) and UnicodeSameText(wOldName, wNewName) then
  1226. begin
  1227. wTmpName:= GetFileSystemType(OldName);
  1228. if UnicodeSameText('FAT32', wTmpName) or UnicodeSameText('exFAT', wTmpName) then
  1229. begin
  1230. wTmpName:= UTF16LongName(GetTempName(OldName));
  1231. Result:= MoveFileExW(PWChar(wOldName), PWChar(wTmpName), 0);
  1232. if Result then
  1233. begin
  1234. Result:= MoveFileExW(PWChar(wTmpName), PWChar(wNewName), 0);
  1235. if not Result then MoveFileExW(PWChar(wTmpName), PWChar(wOldName), 0);
  1236. end;
  1237. Exit;
  1238. end;
  1239. end;
  1240. Result:= MoveFileExW(PWChar(wOldName), PWChar(wNewName), MOVEFILE_REPLACE_EXISTING);
  1241. end;
  1242. {$ELSE}
  1243. var
  1244. tmpFileName: String;
  1245. OldFileStat, NewFileStat: stat;
  1246. begin
  1247. if GetPathType(NewName) <> ptAbsolute then
  1248. NewName := ExtractFilePath(OldName) + NewName;
  1249. if OldName = NewName then
  1250. Exit(True);
  1251. if fpLstat(UTF8ToSys(OldName), OldFileStat) <> 0 then
  1252. Exit(False);
  1253. // Check if target file exists.
  1254. if fpLstat(UTF8ToSys(NewName), NewFileStat) = 0 then
  1255. begin
  1256. // Check if source and target are the same files (same inode and same device).
  1257. if (OldFileStat.st_ino = NewFileStat.st_ino) and
  1258. (OldFileStat.st_dev = NewFileStat.st_dev) then
  1259. begin
  1260. // Check number of links.
  1261. // If it is 1 then source and target names most probably differ only
  1262. // by case on a case-insensitive filesystem. Direct rename() in such case
  1263. // fails on Linux, so we use a temporary file name and rename in two stages.
  1264. // If number of links is more than 1 then it's enough to simply unlink
  1265. // the source file, since both files are technically identical.
  1266. // (On Linux rename() returns success but doesn't do anything
  1267. // if renaming a file to its hard link.)
  1268. // We cannot use st_nlink for directories because it means "number of
  1269. // subdirectories" ("number of all entries" under macOS) in that directory,
  1270. // plus its special entries '.' and '..';
  1271. // hard links to directories are not supported on Linux
  1272. // or Windows anyway (on macOS they are). Therefore we always treat
  1273. // directories as if they were a single link and rename them using temporary name.
  1274. if (NewFileStat.st_nlink = 1) or BaseUnix.fpS_ISDIR(NewFileStat.st_mode) then
  1275. begin
  1276. tmpFileName := GetTempName(OldName);
  1277. if FpRename(UTF8ToSys(OldName), UTF8ToSys(tmpFileName)) = 0 then
  1278. begin
  1279. if fpLstat(UTF8ToSys(NewName), NewFileStat) = 0 then
  1280. begin
  1281. // We have renamed the old file but the new file name still exists,
  1282. // so this wasn't a single file on a case-insensitive filesystem
  1283. // accessible by two names that differ by case.
  1284. FpRename(UTF8ToSys(tmpFileName), UTF8ToSys(OldName)); // Restore old file.
  1285. Result := False;
  1286. end
  1287. else if FpRename(UTF8ToSys(tmpFileName), UTF8ToSys(NewName)) = 0 then
  1288. begin
  1289. Result := True;
  1290. end
  1291. else
  1292. begin
  1293. FpRename(UTF8ToSys(tmpFileName), UTF8ToSys(OldName)); // Restore old file.
  1294. Result := False;
  1295. end;
  1296. end
  1297. else
  1298. Result := False;
  1299. end
  1300. else
  1301. begin
  1302. // Multiple links - simply unlink the source file.
  1303. Result := (fpUnLink(UTF8ToSys(OldName)) = 0);
  1304. end;
  1305. Exit;
  1306. end;
  1307. end;
  1308. Result := FpRename(UTF8ToSys(OldName), UTF8ToSys(NewName)) = 0;
  1309. end;
  1310. {$ENDIF}
  1311. function mbFileSize(const FileName: String): Int64;
  1312. {$IFDEF MSWINDOWS}
  1313. var
  1314. Handle: System.THandle;
  1315. FindData: TWin32FindDataW;
  1316. begin
  1317. Result:= 0;
  1318. Handle := FindFirstFileW(PWideChar(UTF16LongName(FileName)), FindData);
  1319. if Handle <> INVALID_HANDLE_VALUE then
  1320. begin
  1321. Windows.FindClose(Handle);
  1322. if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
  1323. begin
  1324. Int64Rec(Result).Lo:= FindData.nFileSizeLow;
  1325. Int64Rec(Result).Hi:= FindData.nFileSizeHigh;
  1326. end;
  1327. end;
  1328. end;
  1329. {$ELSE}
  1330. var
  1331. Info: BaseUnix.Stat;
  1332. begin
  1333. Result:= 0;
  1334. if fpStat(UTF8ToSys(FileName), Info) >= 0 then
  1335. Result:= Info.st_size;
  1336. end;
  1337. {$ENDIF}
  1338. function FileGetSize(Handle: System.THandle): Int64;
  1339. {$IFDEF MSWINDOWS}
  1340. begin
  1341. Int64Rec(Result).Lo := GetFileSize(Handle, @Int64Rec(Result).Hi);
  1342. end;
  1343. {$ELSE}
  1344. var
  1345. Info: BaseUnix.Stat;
  1346. begin
  1347. if fpFStat(Handle, Info) < 0 then
  1348. Result := -1
  1349. else
  1350. Result := Info.st_size;
  1351. end;
  1352. {$ENDIF}
  1353. function FileFlush(Handle: System.THandle): Boolean; inline;
  1354. {$IFDEF MSWINDOWS}
  1355. begin
  1356. Result:= FlushFileBuffers(Handle);
  1357. end;
  1358. {$ELSE}
  1359. begin
  1360. Result:= (fpfsync(Handle) = 0);
  1361. end;
  1362. {$ENDIF}
  1363. function FileFlushData(Handle: System.THandle): Boolean; inline;
  1364. {$IF DEFINED(LINUX)}
  1365. begin
  1366. Result:= (fpFDataSync(Handle) = 0);
  1367. end;
  1368. {$ELSE}
  1369. begin
  1370. Result:= FileFlush(Handle);
  1371. end;
  1372. {$ENDIF}
  1373. function FileIsReadOnlyEx(Handle: System.THandle): Boolean;
  1374. {$IF DEFINED(MSWINDOWS)}
  1375. var
  1376. Info: BY_HANDLE_FILE_INFORMATION;
  1377. begin
  1378. if GetFileInformationByHandle(Handle, Info) then
  1379. Result:= (Info.dwFileAttributes and (faReadOnly or faHidden or faSysFile) <> 0)
  1380. else
  1381. Result:= False;
  1382. end;
  1383. {$ELSEIF DEFINED(LINUX)}
  1384. var
  1385. Flags: UInt32;
  1386. begin
  1387. if FileGetFlags(Handle, Flags) then
  1388. begin
  1389. if (Flags and (FS_IMMUTABLE_FL or FS_APPEND_FL) <> 0) then
  1390. Exit(True);
  1391. end;
  1392. Result:= False;
  1393. end;
  1394. {$ELSE}
  1395. begin
  1396. Result:= False;
  1397. end;
  1398. {$ENDIF}
  1399. function FileAllocate(Handle: System.THandle; Size: Int64): Boolean;
  1400. {$IF DEFINED(LINUX)}
  1401. var
  1402. Ret: cint;
  1403. Sta: TStat;
  1404. StaFS: TStatFS;
  1405. begin
  1406. if (Size > 0) then
  1407. begin
  1408. repeat
  1409. Ret:= fpfStatFS(Handle, @StaFS);
  1410. until (Ret <> -1) or (fpgeterrno <> ESysEINTR);
  1411. // FAT32 does not support a fast allocation
  1412. if (StaFS.fstype = MSDOS_SUPER_MAGIC) then
  1413. Exit(False);
  1414. repeat
  1415. Ret:= fpFStat(Handle, Sta);
  1416. until (Ret <> -1) or (fpgeterrno <> ESysEINTR);
  1417. if (Ret = 0) and (Sta.st_size < Size) then
  1418. begin
  1419. // New size should be aligned to block size
  1420. Sta.st_size:= (Size + Sta.st_blksize - 1) and not (Sta.st_blksize - 1);
  1421. repeat
  1422. Ret:= fpFAllocate(Handle, 0, 0, Sta.st_size);
  1423. until (Ret <> -1) or (fpgeterrno <> ESysEINTR);
  1424. end;
  1425. end;
  1426. Result:= FileTruncate(Handle, Size);
  1427. end;
  1428. {$ELSE}
  1429. begin
  1430. Result:= FileTruncate(Handle, Size);
  1431. end;
  1432. {$ENDIF}
  1433. function mbGetCurrentDir: String;
  1434. {$IFDEF MSWINDOWS}
  1435. var
  1436. dwSize: DWORD;
  1437. wsDir: UnicodeString;
  1438. begin
  1439. if Length(CurrentDirectory) > 0 then
  1440. Result:= CurrentDirectory
  1441. else
  1442. begin
  1443. dwSize:= GetCurrentDirectoryW(0, nil);
  1444. if dwSize = 0 then
  1445. Result:= EmptyStr
  1446. else begin
  1447. SetLength(wsDir, dwSize + 1);
  1448. SetLength(wsDir, GetCurrentDirectoryW(dwSize, PWideChar(wsDir)));
  1449. Result:= UTF16ToUTF8(wsDir);
  1450. end;
  1451. end;
  1452. end;
  1453. {$ELSE}
  1454. begin
  1455. GetDir(0, Result);
  1456. Result := SysToUTF8(Result);
  1457. end;
  1458. {$ENDIF}
  1459. function mbSetCurrentDir(const NewDir: String): Boolean;
  1460. {$IFDEF MSWINDOWS}
  1461. var
  1462. Handle: THandle;
  1463. wsNewDir: UnicodeString;
  1464. FindData: TWin32FindDataW;
  1465. begin
  1466. if (Pos('\\', NewDir) = 1) then
  1467. Result:= True
  1468. else begin
  1469. wsNewDir:= UTF16LongName(IncludeTrailingBackslash(NewDir)) + '*';
  1470. Handle:= FindFirstFileW(PWideChar(wsNewDir), FindData);
  1471. Result:= (Handle <> INVALID_HANDLE_VALUE) or (GetLastError = ERROR_FILE_NOT_FOUND);
  1472. if (Handle <> INVALID_HANDLE_VALUE) then FindClose(Handle);
  1473. end;
  1474. if Result then CurrentDirectory:= NewDir;
  1475. end;
  1476. {$ELSE}
  1477. begin
  1478. Result:= fpChDir(UTF8ToSys(NewDir)) = 0;
  1479. end;
  1480. {$ENDIF}
  1481. function mbDirectoryExists(const Directory: String) : Boolean;
  1482. {$IFDEF MSWINDOWS}
  1483. var
  1484. Attr: DWORD;
  1485. begin
  1486. Attr:= GetFileAttributesW(PWideChar(UTF16LongName(Directory)));
  1487. if Attr <> DWORD(-1) then
  1488. Result:= (Attr and FILE_ATTRIBUTE_DIRECTORY) > 0
  1489. else
  1490. Result:= False;
  1491. end;
  1492. {$ELSE}
  1493. var
  1494. Info: BaseUnix.Stat;
  1495. begin
  1496. // We can use fpStat here instead of fpLstat, so that True is returned
  1497. // when target is a directory or a link to an existing directory.
  1498. // Note that same behaviour would be achieved by passing paths
  1499. // that end with path delimiter to fpLstat.
  1500. // Paths with links can be used the same way as if they were real directories.
  1501. if fpStat(UTF8ToSys(Directory), Info) >= 0 then
  1502. Result:= fpS_ISDIR(Info.st_mode)
  1503. else
  1504. Result:= False;
  1505. end;
  1506. {$ENDIF}
  1507. function mbCreateDir(const NewDir: String): Boolean;
  1508. {$IFDEF MSWINDOWS}
  1509. begin
  1510. Result:= CreateDirectoryW(PWideChar(UTF16LongName(NewDir)), nil);
  1511. end;
  1512. {$ELSE}
  1513. begin
  1514. Result:= fpMkDir(UTF8ToSys(NewDir), $1FF) = 0; // $1FF = &0777
  1515. end;
  1516. {$ENDIF}
  1517. function mbRemoveDir(const Dir: String): Boolean;
  1518. {$IFDEF MSWINDOWS}
  1519. begin
  1520. Result:= RemoveDirectoryW(PWideChar(UTF16LongName(Dir)));
  1521. if not Result then Result:= (GetLastError = ERROR_FILE_NOT_FOUND);
  1522. end;
  1523. {$ELSE}
  1524. begin
  1525. Result:= fpRmDir(UTF8ToSys(Dir)) = 0;
  1526. if not Result then Result:= (fpgetErrNo = ESysENOENT);
  1527. end;
  1528. {$ENDIF}
  1529. function mbFileSystemEntryExists(const Path: String): Boolean;
  1530. begin
  1531. Result := mbFileGetAttr(Path) <> faInvalidAttributes;
  1532. end;
  1533. function mbCompareFileNames(const FileName1, FileName2: String): Boolean;
  1534. {$IF DEFINED(DARWIN)}
  1535. begin
  1536. if (Length(FileName1) = 0) or (Length(FileName2) = 0) then
  1537. Result:= (FileName1 = FileName2)
  1538. else begin
  1539. Result:= CompareFilenamesIgnoreCase(FileName1, FileName2) = 0;
  1540. end;
  1541. end;
  1542. {$ELSEIF DEFINED(MSWINDOWS)}
  1543. begin
  1544. Result:= (UnicodeCompareText(CeUtf8ToUtf16(FileName1), CeUtf8ToUtf16(FileName2)) = 0);
  1545. end;
  1546. {$ELSE}
  1547. begin
  1548. Result:= (UnicodeCompareStr(CeUtf8ToUtf16(FileName1), CeUtf8ToUtf16(FileName2)) = 0);
  1549. end;
  1550. {$ENDIF}
  1551. function mbFileSame(const FileName1, FileName2: String): Boolean;
  1552. {$IF DEFINED(MSWINDOWS)}
  1553. var
  1554. Device1, Device2: TStringArray;
  1555. FileHandle1, FileHandle2: System.THandle;
  1556. FileInfo1, FileInfo2: BY_HANDLE_FILE_INFORMATION;
  1557. begin
  1558. Result := mbCompareFileNames(FileName1, FileName2);
  1559. if not Result then
  1560. begin
  1561. FileHandle1 := CreateFileW(PWideChar(UTF16LongName(FileName1)), FILE_READ_ATTRIBUTES,
  1562. FILE_SHARE_READ or FILE_SHARE_WRITE or FILE_SHARE_DELETE,
  1563. nil, OPEN_EXISTING, 0, 0);
  1564. if FileHandle1 <> INVALID_HANDLE_VALUE then
  1565. begin
  1566. FileHandle2 := CreateFileW(PWideChar(UTF16LongName(FileName2)), FILE_READ_ATTRIBUTES,
  1567. FILE_SHARE_READ or FILE_SHARE_WRITE or FILE_SHARE_DELETE,
  1568. nil, OPEN_EXISTING, 0, 0);
  1569. if FileHandle2 <> INVALID_HANDLE_VALUE then
  1570. begin
  1571. if GetFileInformationByHandle(FileHandle1, FileInfo1) and
  1572. GetFileInformationByHandle(FileHandle2, FileInfo2) then
  1573. begin
  1574. // Check if both files have the same index on the same volume.
  1575. // This check is valid only while both files are open.
  1576. Result := (FileInfo1.dwVolumeSerialNumber = FileInfo2.dwVolumeSerialNumber) and
  1577. (FileInfo1.nFileIndexHigh = FileInfo2.nFileIndexHigh) and
  1578. (FileInfo1.nFileIndexLow = FileInfo2.nFileIndexLow);
  1579. // Check that both files on the same physical drive (bug 0001774)
  1580. if Result then
  1581. begin
  1582. Device1:= AnsiString(GetFinalPathNameByHandle(FileHandle1)).Split([PathDelim]);
  1583. Device2:= AnsiString(GetFinalPathNameByHandle(FileHandle2)).Split([PathDelim]);
  1584. Result:= (Length(Device1) > 2) and (Length(Device2) > 2) and (Device1[2] = Device2[2]);
  1585. end;
  1586. end;
  1587. CloseHandle(FileHandle2);
  1588. end;
  1589. CloseHandle(FileHandle1);
  1590. end
  1591. end;
  1592. end;
  1593. {$ELSEIF DEFINED(UNIX)}
  1594. var
  1595. File1Stat, File2Stat: stat;
  1596. begin
  1597. Result := mbCompareFileNames(FileName1, FileName2) or
  1598. (
  1599. (fpLstat(UTF8ToSys(FileName1), File1Stat) = 0) and
  1600. (fpLstat(UTF8ToSys(FileName2), File2Stat) = 0) and
  1601. (File1Stat.st_ino = File2Stat.st_ino) and
  1602. (File1Stat.st_dev = File2Stat.st_dev)
  1603. );
  1604. end;
  1605. {$ENDIF}
  1606. function mbFileSameVolume(const FileName1, FileName2: String): Boolean;
  1607. {$IF DEFINED(MSWINDOWS)}
  1608. var
  1609. lpszVolumePathName1: array[0..maxSmallint] of WideChar;
  1610. lpszVolumePathName2: array[0..maxSmallint] of WideChar;
  1611. begin
  1612. Result:= GetVolumePathNameW(PWideChar(UTF16LongName(FileName1)), PWideChar(lpszVolumePathName1), maxSmallint) and
  1613. GetVolumePathNameW(PWideChar(UTF16LongName(FileName2)), PWideChar(lpszVolumePathName2), maxSmallint) and
  1614. WideSameText(ExtractFileDrive(lpszVolumePathName1), ExtractFileDrive(lpszVolumePathName2));
  1615. end;
  1616. {$ELSE}
  1617. var
  1618. Stat1, Stat2: Stat;
  1619. begin
  1620. Result:= (fpLStat(UTF8ToSys(FileName1), Stat1) = 0) and
  1621. (fpLStat(UTF8ToSys(FileName2), Stat2) = 0) and
  1622. (Stat1.st_dev = Stat2.st_dev);
  1623. end;
  1624. {$ENDIF}
  1625. function mbGetEnvironmentString(Index: Integer): String;
  1626. {$IFDEF MSWINDOWS}
  1627. var
  1628. hp, p: PWideChar;
  1629. begin
  1630. Result:= '';
  1631. p:= GetEnvironmentStringsW;
  1632. hp:= p;
  1633. if (hp <> nil) then
  1634. begin
  1635. while (hp^ <> #0) and (Index > 1) do
  1636. begin
  1637. Dec(Index);
  1638. hp:= hp + lstrlenW(hp) + 1;
  1639. end;
  1640. if (hp^ <> #0) then
  1641. Result:= UTF16ToUTF8(UnicodeString(hp));
  1642. end;
  1643. FreeEnvironmentStringsW(p);
  1644. end;
  1645. {$ELSE}
  1646. begin
  1647. Result:= SysToUTF8(GetEnvironmentString(Index));
  1648. end;
  1649. {$ENDIF}
  1650. function mbExpandEnvironmentStrings(const FileName: String): String;
  1651. {$IF DEFINED(MSWINDOWS)}
  1652. var
  1653. dwSize: DWORD;
  1654. wsResult: UnicodeString;
  1655. begin
  1656. SetLength(wsResult, MaxSmallInt + 1);
  1657. dwSize:= ExpandEnvironmentStringsW(PWideChar(CeUtf8ToUtf16(FileName)), PWideChar(wsResult), MaxSmallInt);
  1658. if (dwSize = 0) or (dwSize > MaxSmallInt) then
  1659. Result:= FileName
  1660. else begin
  1661. SetLength(wsResult, dwSize - 1);
  1662. Result:= UTF16ToUTF8(wsResult);
  1663. end;
  1664. end;
  1665. {$ELSE}
  1666. var
  1667. Index: Integer = 1;
  1668. EnvCnt, EqualPos: Integer;
  1669. EnvVar, EnvName, EnvValue: String;
  1670. begin
  1671. Result:= FileName;
  1672. EnvCnt:= GetEnvironmentVariableCount;
  1673. while (Index <= EnvCnt) and (Pos('$', Result) > 0) do
  1674. begin
  1675. EnvVar:= mbGetEnvironmentString(Index);
  1676. EqualPos:= Pos('=', EnvVar);
  1677. if EqualPos = 0 then Continue;
  1678. EnvName:= Copy(EnvVar, 1, EqualPos - 1);
  1679. EnvValue:= Copy(EnvVar, EqualPos + 1, MaxInt);
  1680. Result:= StringReplace(Result, '$' + EnvName, EnvValue, [rfReplaceAll]);
  1681. Inc(Index);
  1682. end;
  1683. end;
  1684. {$ENDIF}
  1685. function mbGetEnvironmentVariable(const sName: String): String;
  1686. {$IFDEF MSWINDOWS}
  1687. var
  1688. wsName: UnicodeString;
  1689. smallBuf: array[0..1023] of WideChar;
  1690. largeBuf: PWideChar;
  1691. dwResult: DWORD;
  1692. begin
  1693. Result := EmptyStr;
  1694. wsName := CeUtf8ToUtf16(sName);
  1695. dwResult := GetEnvironmentVariableW(PWideChar(wsName), @smallBuf[0], Length(smallBuf));
  1696. if dwResult > Length(smallBuf) then
  1697. begin
  1698. // Buffer not large enough.
  1699. largeBuf := GetMem(SizeOf(WideChar) * dwResult);
  1700. if Assigned(largeBuf) then
  1701. try
  1702. dwResult := GetEnvironmentVariableW(PWideChar(wsName), largeBuf, dwResult);
  1703. if dwResult > 0 then
  1704. Result := UTF16ToUTF8(UnicodeString(largeBuf));
  1705. finally
  1706. FreeMem(largeBuf);
  1707. end;
  1708. end
  1709. else if dwResult > 0 then
  1710. Result := UTF16ToUTF8(UnicodeString(smallBuf));
  1711. end;
  1712. {$ELSE}
  1713. begin
  1714. Result:= CeSysToUtf8(getenv(PAnsiChar(CeUtf8ToSys(sName))));
  1715. end;
  1716. {$ENDIF}
  1717. function mbSetEnvironmentVariable(const sName, sValue: String): Boolean;
  1718. {$IFDEF MSWINDOWS}
  1719. var
  1720. wsName,
  1721. wsValue: UnicodeString;
  1722. begin
  1723. wsName:= CeUtf8ToUtf16(sName);
  1724. wsValue:= CeUtf8ToUtf16(sValue);
  1725. Result:= SetEnvironmentVariableW(PWideChar(wsName), PWideChar(wsValue));
  1726. end;
  1727. {$ELSE}
  1728. begin
  1729. Result:= (setenv(PAnsiChar(CeUtf8ToSys(sName)), PAnsiChar(CeUtf8ToSys(sValue)), 1) = 0);
  1730. end;
  1731. {$ENDIF}
  1732. function mbUnsetEnvironmentVariable(const sName: String): Boolean;
  1733. {$IFDEF MSWINDOWS}
  1734. var
  1735. wsName: UnicodeString;
  1736. begin
  1737. wsName:= CeUtf8ToUtf16(sName);
  1738. Result:= SetEnvironmentVariableW(PWideChar(wsName), NIL);
  1739. end;
  1740. {$ELSE}
  1741. begin
  1742. Result:= (unsetenv(PAnsiChar(CeUtf8ToSys(sName))) = 0);
  1743. end;
  1744. {$ENDIF}
  1745. function mbSysErrorMessage: String;
  1746. begin
  1747. Result := mbSysErrorMessage(GetLastOSError);
  1748. end;
  1749. function mbSysErrorMessage(ErrorCode: Integer): String;
  1750. begin
  1751. Result := SysErrorMessage(ErrorCode);
  1752. {$IF (FPC_FULLVERSION < 30004)}
  1753. Result := CeSysToUtf8(Result);
  1754. {$ENDIF}
  1755. end;
  1756. function mbGetModuleName(Address: Pointer): String;
  1757. const
  1758. Dummy: Boolean = False;
  1759. {$IFDEF UNIX}
  1760. var
  1761. dlinfo: dl_info;
  1762. begin
  1763. if Address = nil then Address:= @Dummy;
  1764. FillChar({%H-}dlinfo, SizeOf(dlinfo), #0);
  1765. if dladdr(Address, @dlinfo) = 0 then
  1766. Result:= EmptyStr
  1767. else begin
  1768. Result:= CeSysToUtf8(dlinfo.dli_fname);
  1769. end;
  1770. end;
  1771. {$ELSE}
  1772. var
  1773. ModuleName: UnicodeString;
  1774. lpBuffer: TMemoryBasicInformation;
  1775. begin
  1776. if Address = nil then Address:= @Dummy;
  1777. if VirtualQuery(Address, @lpBuffer, SizeOf(lpBuffer)) <> SizeOf(lpBuffer) then
  1778. Result:= EmptyStr
  1779. else begin
  1780. SetLength(ModuleName, MAX_PATH + 1);
  1781. SetLength(ModuleName, GetModuleFileNameW({%H-}THandle(lpBuffer.AllocationBase),
  1782. PWideChar(ModuleName), MAX_PATH));
  1783. Result:= UTF16ToUTF8(ModuleName);
  1784. end;
  1785. end;
  1786. {$ENDIF}
  1787. function mbLoadLibrary(const Name: String): TLibHandle;
  1788. {$IFDEF MSWINDOWS}
  1789. var
  1790. dwMode: DWORD;
  1791. dwErrCode: DWORD;
  1792. sRememberPath: String;
  1793. begin
  1794. dwMode:= SetErrorMode(SEM_FAILCRITICALERRORS or SEM_NOOPENFILEERRORBOX);
  1795. try
  1796. // Some plugins using DLL(s) in their directory are loaded correctly only if "CurrentDir" is poining their location.
  1797. // Also, TC switch "CurrentDir" to their directory when loading them. So let's do the same.
  1798. sRememberPath:= GetCurrentDir;
  1799. SetCurrentDir(ExtractFileDir(Name));
  1800. Result:= SafeLoadLibrary(CeUtf8ToUtf16(Name));
  1801. dwErrCode:= GetLastError;
  1802. finally
  1803. SetErrorMode(dwMode);
  1804. SetCurrentDir(sRememberPath);
  1805. SetLastError(dwErrCode);
  1806. end;
  1807. end;
  1808. {$ELSE}
  1809. begin
  1810. Result:= SafeLoadLibrary(CeUtf8ToSys(Name));
  1811. end;
  1812. {$ENDIF}
  1813. function mbLoadLibraryEx(const Name: String): TLibHandle;
  1814. {$IF DEFINED(MSWINDOWS)}
  1815. const
  1816. PATH_ENV = 'PATH';
  1817. var
  1818. dwFlags:DWORD;
  1819. APath: String;
  1820. APathType: TPathType;
  1821. usName: UnicodeString;
  1822. begin
  1823. usName:= CeUtf8ToUtf16(Name);
  1824. APathType:= GetPathType(Name);
  1825. if CheckWin32Version(10) or (GetProcAddress(GetModuleHandleW(Kernel32), 'AddDllDirectory') <> nil) then
  1826. begin
  1827. if APathType <> ptAbsolute then
  1828. dwFlags:= 0
  1829. else begin
  1830. dwFlags:= LOAD_LIBRARY_SEARCH_DLL_LOAD_DIR;
  1831. end;
  1832. Result:= LoadLibraryExW(PWideChar(usName), 0, dwFlags or LOAD_LIBRARY_SEARCH_DEFAULT_DIRS);
  1833. end
  1834. else begin
  1835. APath:= mbGetEnvironmentVariable(PATH_ENV);
  1836. try
  1837. if APathType <> ptAbsolute then
  1838. SetDllDirectoryW(PWideChar(''))
  1839. else begin
  1840. SetDllDirectoryW(PWideChar(ExtractFileDir(usName)));
  1841. end;
  1842. try
  1843. SetEnvironmentVariableW(PATH_ENV, nil);
  1844. Result:= LoadLibraryW(PWideChar(usName));
  1845. finally
  1846. SetDllDirectoryW(nil);
  1847. end;
  1848. finally
  1849. mbSetEnvironmentVariable(PATH_ENV, APath);
  1850. end;
  1851. end;
  1852. end;
  1853. {$ELSE}
  1854. begin
  1855. Result:= SafeLoadLibrary(CeUtf8ToSys(Name));
  1856. end;
  1857. {$ENDIF}
  1858. function SafeGetProcAddress(Lib: TLibHandle; const ProcName: AnsiString): Pointer;
  1859. begin
  1860. Result:= GetProcedureAddress(Lib, ProcName);
  1861. if (Result = nil) then raise Exception.Create(ProcName);
  1862. end;
  1863. function mbReadAllLinks(const PathToLink: String) : String;
  1864. var
  1865. Attrs: TFileAttrs;
  1866. LinkTargets: TStringList; // A list of encountered filenames (for detecting cycles)
  1867. function mbReadAllLinksRec(const PathToLink: String): String;
  1868. begin
  1869. Result := ReadSymLink(PathToLink);
  1870. if Result <> '' then
  1871. begin
  1872. if GetPathType(Result) <> ptAbsolute then
  1873. Result := GetAbsoluteFileName(ExtractFilePath(PathToLink), Result);
  1874. if LinkTargets.IndexOf(Result) >= 0 then
  1875. begin
  1876. // Link already encountered - links form a cycle.
  1877. Result := '';
  1878. {$IFDEF UNIX}
  1879. fpseterrno(ESysELOOP);
  1880. {$ENDIF}
  1881. Exit;
  1882. end;
  1883. Attrs := mbFileGetAttr(Result);
  1884. if (Attrs <> faInvalidAttributes) then
  1885. begin
  1886. if FPS_ISLNK(Attrs) then
  1887. begin
  1888. // Points to a link - read recursively.
  1889. LinkTargets.Add(Result);
  1890. Result := mbReadAllLinksRec(Result);
  1891. end;
  1892. // else points to a file/dir
  1893. end
  1894. else
  1895. begin
  1896. Result := ''; // Target of link doesn't exist
  1897. {$IFDEF UNIX}
  1898. fpseterrno(ESysENOENT);
  1899. {$ENDIF}
  1900. end;
  1901. end;
  1902. end;
  1903. begin
  1904. LinkTargets := TStringList.Create;
  1905. try
  1906. Result := mbReadAllLinksRec(PathToLink);
  1907. finally
  1908. FreeAndNil(LinkTargets);
  1909. end;
  1910. end;
  1911. function mbCheckReadLinks(const PathToLink : String): String;
  1912. var
  1913. Attrs: TFileAttrs;
  1914. begin
  1915. Attrs := mbFileGetAttr(PathToLink);
  1916. if (Attrs <> faInvalidAttributes) and FPS_ISLNK(Attrs) then
  1917. Result := mbReadAllLinks(PathToLink)
  1918. else
  1919. Result := PathToLink;
  1920. end;
  1921. function mbFileGetAttrNoLinks(const FileName: String): TFileAttrs;
  1922. {$IFDEF UNIX}
  1923. var
  1924. Info: BaseUnix.Stat;
  1925. begin
  1926. if fpStat(UTF8ToSys(FileName), Info) >= 0 then
  1927. Result := Info.st_mode
  1928. else
  1929. Result := faInvalidAttributes;
  1930. end;
  1931. {$ELSE}
  1932. var
  1933. LinkTarget: String;
  1934. begin
  1935. LinkTarget := mbReadAllLinks(FileName);
  1936. if LinkTarget <> '' then
  1937. Result := mbFileGetAttr(LinkTarget)
  1938. else
  1939. Result := faInvalidAttributes;
  1940. end;
  1941. {$ENDIF}
  1942. function CreateHardLink(const Path, LinkName: String) : Boolean;
  1943. {$IFDEF MSWINDOWS}
  1944. var
  1945. wsPath, wsLinkName: UnicodeString;
  1946. begin
  1947. wsPath:= UTF16LongName(Path);
  1948. wsLinkName:= UTF16LongName(LinkName);
  1949. Result:= DCNtfsLinks.CreateHardlink(wsPath, wsLinkName);
  1950. end;
  1951. {$ELSE}
  1952. begin
  1953. Result := (fplink(PAnsiChar(CeUtf8ToSys(Path)),PAnsiChar(CeUtf8ToSys(LinkName)))=0);
  1954. end;
  1955. {$ENDIF}
  1956. function CreateSymLink(const Path, LinkName: string; Attr: UInt32): Boolean;
  1957. {$IFDEF MSWINDOWS}
  1958. var
  1959. wsPath, wsLinkName: UnicodeString;
  1960. begin
  1961. wsPath:= CeUtf8ToUtf16(Path);
  1962. wsLinkName:= UTF16LongName(LinkName);
  1963. Result:= DCNtfsLinks.CreateSymlink(wsPath, wsLinkName, Attr);
  1964. end;
  1965. {$ELSE}
  1966. begin
  1967. Result := (fpsymlink(PAnsiChar(CeUtf8ToSys(Path)), PAnsiChar(CeUtf8ToSys(LinkName)))=0);
  1968. end;
  1969. {$ENDIF}
  1970. function ReadSymLink(const LinkName : String) : String;
  1971. {$IFDEF MSWINDOWS}
  1972. var
  1973. wsLinkName, wsTarget: UnicodeString;
  1974. begin
  1975. wsLinkName:= UTF16LongName(LinkName);
  1976. if DCNtfsLinks.ReadSymLink(wsLinkName, wsTarget) then
  1977. Result := UTF16ToUTF8(wsTarget)
  1978. else
  1979. Result := EmptyStr;
  1980. end;
  1981. {$ELSE}
  1982. begin
  1983. Result := SysToUTF8(fpReadlink(UTF8ToSys(LinkName)));
  1984. end;
  1985. {$ENDIF}
  1986. procedure SetLastOSError(LastError: Integer);
  1987. {$IFDEF MSWINDOWS}
  1988. begin
  1989. SetLastError(UInt32(LastError));
  1990. end;
  1991. {$ELSE}
  1992. begin
  1993. fpseterrno(LastError);
  1994. end;
  1995. {$ENDIF}
  1996. function GetTickCountEx: UInt64;
  1997. begin
  1998. {$IF DEFINED(MSWINDOWS)}
  1999. if QueryPerformanceCounter(PLARGE_INTEGER(@Result)) then
  2000. Result:= Result div PerformanceFrequency.QuadPart
  2001. else
  2002. {$ENDIF}
  2003. begin
  2004. Result:= SysUtils.GetTickCount64;
  2005. end;
  2006. end;
  2007. {$IFDEF MSWINDOWS}
  2008. initialization
  2009. if QueryPerformanceFrequency(@PerformanceFrequency) then
  2010. PerformanceFrequency.QuadPart := PerformanceFrequency.QuadPart div 1000;
  2011. {$ENDIF}
  2012. end.