dcosutils.pas 60 KB

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