dcosutils.pas 60 KB

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