Quick.Files.pas 38 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375
  1. { ***************************************************************************
  2. Copyright (c) 2016-2019 Kike Pérez
  3. Unit : Quick.Files
  4. Description : Files functions
  5. Author : Kike Pérez
  6. Version : 1.5
  7. Created : 09/03/2018
  8. Modified : 23/05/2019
  9. This file is part of QuickLib: https://github.com/exilon/QuickLib
  10. ***************************************************************************
  11. Licensed under the Apache License, Version 2.0 (the "License");
  12. you may not use this file except in compliance with the License.
  13. You may obtain a copy of the License at
  14. http://www.apache.org/licenses/LICENSE-2.0
  15. Unless required by applicable law or agreed to in writing, software
  16. distributed under the License is distributed on an "AS IS" BASIS,
  17. WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  18. See the License for the specific language governing permissions and
  19. limitations under the License.
  20. *************************************************************************** }
  21. unit Quick.Files;
  22. {$i QuickLib.inc}
  23. interface
  24. uses
  25. Classes,
  26. SysUtils,
  27. {$IFDEF MSWINDOWS}
  28. Windows,
  29. {$ENDIF}
  30. {$IFDEF FPC}
  31. strutils,
  32. {$IFDEF LINUX}
  33. baseunix,
  34. {$ENDIF}
  35. {$ENDIF}
  36. {$IFDEF POSIX}
  37. Posix.Base,
  38. Posix.SysStat,
  39. Posix.Utime,
  40. {$ENDIF}
  41. DateUtils;
  42. {$IFDEF FPC}
  43. resourcestring
  44. SPathTooLong = 'The specified path is too long';
  45. SPathNotFound = 'The specified path was not found';
  46. SPathFormatNotSupported = 'The path format is not supported';
  47. SDirectoryNotEmpty = 'The specified directory is not empty';
  48. SDirectoryAlreadyExists = 'The specified directory already exists';
  49. SDirectoryInvalid = 'The specified directory name is invalid';
  50. SSourceDirIsDestDir = 'The source directory is the same as the destination directory';
  51. SSourceFileIsDestFile = 'The source file is the same as the destination file';
  52. SPathToFileNeeded = 'The path must specify a file';
  53. SSameRootDrive = 'The source and destination paths must contain the same root drive';
  54. SDriveNotFound = 'The drive cannot be found';
  55. SFileNotFound = 'The specified file was not found';
  56. SFileAlreadyExists = 'The specified file already exists';
  57. SInvalidCharsInPath = 'Invalid characters in path';
  58. SInvalidCharsInFileName = 'Invalid characters in file name';
  59. {$ENDIF}
  60. type
  61. {$IFNDEF FPC}
  62. TTextFileOperation = (tfOpenRead,tfOpenOverwrite,tfOpenAppend);
  63. TTextStreamFile = class
  64. private
  65. fReadStream : TStreamReader;
  66. fWriteStream : TStreamWriter;
  67. function GetEOF : Boolean;
  68. public
  69. constructor Create(const aFileName : string; aOpenMode : TTextFileOperation);
  70. destructor Destroy; override;
  71. function ReadLn: string; overload;
  72. function ReadLn(out Data: string): Boolean; overload;
  73. procedure WriteLn (const Data : string);
  74. procedure Close;
  75. property EOF: Boolean read GetEOF;
  76. end;
  77. {$IF Defined(MACOS) OR Defined(NEXTGEN) OR Defined(DELPHILINUX)}
  78. TFileTime = LongInt;
  79. {$ENDIF}
  80. {$ELSE}
  81. {$IFDEF LINUX}
  82. TFILETIME = LongInt;
  83. {$ENDIF}
  84. {$ENDIF}
  85. {$IFDEF FPC}
  86. EStreamError = class(Exception);
  87. EFileStreamError = class(EStreamError)
  88. constructor Create(ResStringRec: PResStringRec; const FileName: string);
  89. end;
  90. TPathPrefixType = (pptNoPrefix, pptExtended, pptExtendedUNC);
  91. { TPath }
  92. TPath = class
  93. private
  94. const
  95. FCCurrentDir: string = '.';
  96. FCParentDir: string = '..';
  97. FCExtendedPrefix: string = '\\?\';
  98. FCExtendedUNCPrefix: string = '\\?\UNC\';
  99. class procedure CheckPathLength(const Path: string; const MaxLength: Integer);
  100. public
  101. class function GetFileNameWithoutExtension(const FileName : string) : string;
  102. class function GetDirectoryName(const FileName : string) : string;
  103. class function GetExtension(const Path : string) : string;
  104. class function ChangeExtension(const Path, NewExtension : string) : string;
  105. class function GetFileName(const aPath : string) : string;
  106. class function EndsWithDelimiter(const aPath : string) : Boolean;
  107. class function Combine(const aPath1, aPath2 : string) : string;
  108. end;
  109. TDirectory = class
  110. public
  111. class function Exists(const Path: string; FollowLink: Boolean = True): Boolean;
  112. class function GetDirectories(const Path : string) : TArray<string>;
  113. end;
  114. TFile = class
  115. public
  116. class function Exists(const Path : string) : Boolean;
  117. class function IsInUse(const Path : string) : Boolean;
  118. class function GetSize(const Path : string) : Int64;
  119. class function Create(const Path: string; const BufferSize: Integer): TFileStream; overload;
  120. class function Create(const Path: string): TFileStream; overload;
  121. class function GetExtension(const Path : string) : string;
  122. class function GetCreationTime(const Path : string): TDateTime;
  123. class function GetLastAccessTime(const Path : string): TDateTime;
  124. class function GetLastWriteTime(const Path : string): TDateTime;
  125. class procedure SetCreationTime(const Path: string; const CreationTime: TDateTime);
  126. class procedure SetLastAccessTime(const Path: string; const LastAccessTime: TDateTime);
  127. class procedure SetLastWriteTime(const Path: string; const LastWriteTime: TDateTime);
  128. class function IsReadOnly(const Path : string) : Boolean;
  129. class function Delete(const Path : string) : Boolean;
  130. class function Move(const SourceFileName, DestFileName: string) : Boolean;
  131. end;
  132. TTextWriter = class
  133. public
  134. procedure Close; virtual; abstract;
  135. procedure Flush; virtual; abstract;
  136. procedure Write(Value: Boolean); overload; virtual; abstract;
  137. procedure Write(Value: Char); overload; virtual; abstract;
  138. procedure Write(Value: Double); overload; virtual; abstract;
  139. procedure Write(Value: Integer); overload; virtual; abstract;
  140. procedure Write(Value: Int64); overload; virtual; abstract;
  141. procedure Write(Value: TObject); overload; virtual; abstract;
  142. procedure Write(Value: Single); overload; virtual; abstract;
  143. procedure Write(const Value: string); overload; virtual; abstract;
  144. procedure Write(const aFormat: string; Args: array of const); overload; virtual; abstract;
  145. procedure WriteLine; overload; virtual; abstract;
  146. procedure WriteLine(Value: Boolean); overload; virtual; abstract;
  147. procedure WriteLine(Value: Char); overload; virtual; abstract;
  148. procedure WriteLine(Value: Double); overload; virtual; abstract;
  149. procedure WriteLine(Value: Integer); overload; virtual; abstract;
  150. procedure WriteLine(Value: Int64); overload; virtual; abstract;
  151. procedure WriteLine(Value: TObject); overload; virtual; abstract;
  152. procedure WriteLine(Value: Single); overload; virtual; abstract;
  153. procedure WriteLine(const Value: string); overload; virtual; abstract;
  154. procedure WriteLine(const aFormat: string; Args: array of const); overload; virtual; abstract;
  155. end;
  156. TStreamWriter = class(TTextWriter)
  157. private
  158. FStream: TStream;
  159. FEncoding: TEncoding;
  160. FNewLine: string;
  161. FAutoFlush: Boolean;
  162. FOwnsStream: Boolean;
  163. FBufferIndex: Integer;
  164. FBuffer: TBytes;
  165. procedure WriteBytes(Bytes: TBytes);
  166. public
  167. constructor Create(Stream: TStream); overload;
  168. constructor Create(Stream: TStream; Encoding: TEncoding; BufferSize: Integer = 4096); overload;
  169. constructor Create(const Filename: string; Append: Boolean = False); overload;
  170. constructor Create(const Filename: string; Append: Boolean; Encoding: TEncoding; BufferSize: Integer = 4096); overload;
  171. destructor Destroy; override;
  172. procedure Close; override;
  173. procedure Flush; override;
  174. procedure OwnStream; inline;
  175. procedure Write(Value: Boolean); override;
  176. procedure Write(Value: Char); override;
  177. procedure Write(Value: Double); override;
  178. procedure Write(Value: Integer); override;
  179. procedure Write(Value: Int64); override;
  180. procedure Write(Value: TObject); override;
  181. procedure Write(Value: Single); override;
  182. procedure Write(const Value: string); override;
  183. procedure Write(const aFormat: string; Args: array of const); override;
  184. procedure WriteLine; override;
  185. procedure WriteLine(Value: Boolean); override;
  186. procedure WriteLine(Value: Char); override;
  187. procedure WriteLine(Value: Double); override;
  188. procedure WriteLine(Value: Integer); override;
  189. procedure WriteLine(Value: Int64); override;
  190. procedure WriteLine(Value: TObject); override;
  191. procedure WriteLine(Value: Single); override;
  192. procedure WriteLine(const Value: string); override;
  193. procedure WriteLine(const aFormat: string; Args: array of const); override;
  194. property AutoFlush: Boolean read FAutoFlush write FAutoFlush;
  195. property NewLine: string read FNewLine write FNewLine;
  196. property Encoding: TEncoding read FEncoding;
  197. property BaseStream: TStream read FStream;
  198. end;
  199. {$ENDIF FPC}
  200. TDirItem = record
  201. private
  202. fName : string;
  203. fIsDirectory : Boolean;
  204. fSize : Int64;
  205. fCreationDate : TDateTime;
  206. fLastModified : TDateTime;
  207. public
  208. property Name : string read fName write fName;
  209. property IsDirectory : Boolean read fIsDirectory write fIsDirectory;
  210. property Size : Int64 read fSize write fSize;
  211. property CreationDate : TDateTime read fCreationDate write fCreationDate;
  212. property LastModified : TDateTime read fLastModified write fLastModified;
  213. end;
  214. function CreateDummyFile(const aFilename : string; const aSize : Int64) : Boolean;
  215. procedure SplitFile(const aFileName : string; aSplitByteSize : Int64);
  216. procedure MergeFiles(const aFirstSplitFileName, aOutFileName : string); overload;
  217. procedure MergeFiles(aFilenames : array of string; const aOutFileName : string); overload;
  218. {$IFNDEF NEXTGEN}
  219. function IsFileInUse(const aFileName : string) : Boolean;
  220. {$ENDIF}
  221. procedure FileReplaceText(const aFileName, aSearchText, AReplaceText : string);
  222. {$IFNDEF NEXTGEN}
  223. function FileSearchText(const aFileName, SearchText: string; caseSensitive : Boolean): Longint;
  224. {$ENDIF}
  225. function GetCreationTime(const aFilename : string): TDateTime;
  226. function GetLastAccessTime(const aFileName: string): TDateTime;
  227. function GetLastWriteTime(const aFileName : string): TDateTime;
  228. {$IFDEF FPC}
  229. function FindDelimiter(const Delimiters, S: string; StartIdx: Integer = 1): Integer;
  230. {$ENDIF}
  231. function ConvertDateTimeToFileTime(const DateTime: TDateTime; const UseLocalTimeZone: Boolean): TFileTime;
  232. function ConvertFileTimeToDateTime(const FileTime : TFileTime; const UseLocalTimeZone : Boolean) : TDateTime;
  233. procedure SetDateTimeInfo(const Path: string; const CreationTime, LastAccessTime, LastWriteTime: PDateTime; const UseLocalTimeZone: Boolean);
  234. function GetFiles(const Path : string; Recursive : Boolean) : TArray<TDirItem>;
  235. function GetDirectories(const Path : string; Recursive : Boolean) : TArray<TDirItem>;
  236. function GetFilesAndDirectories(const Path : string; Recursive : Boolean) : TArray<TDirItem>;
  237. implementation
  238. { TTextStreamFile }
  239. {$IFNDEF FPC}
  240. constructor TTextStreamFile.Create(const aFileName : string; aOpenMode : TTextFileOperation);
  241. var
  242. Append : Boolean;
  243. begin
  244. if aOpenMode = tfOpenRead then fReadStream := TStreamReader.Create(aFileName,True)
  245. else
  246. begin
  247. if aOpenMode = tfOpenAppend then Append := True
  248. else Append := False;
  249. fWriteStream := TStreamWriter.Create(aFileName,Append);
  250. end;
  251. end;
  252. destructor TTextStreamFile.Destroy;
  253. begin
  254. if Assigned(fReadStream) then fReadStream.Free;
  255. if Assigned(fWriteStream) then fWriteStream.Free;
  256. inherited Destroy;
  257. end;
  258. function TTextStreamFile.ReadLn(out Data: string): Boolean;
  259. begin
  260. Data := fReadStream.ReadLine;
  261. Result := Data <> '';
  262. end;
  263. function TTextStreamFile.ReadLn: string;
  264. begin
  265. Result := fReadStream.ReadLine;
  266. end;
  267. procedure TTextStreamFile.WriteLn (const Data : string);
  268. begin
  269. fWriteStream.WriteLine(Data);
  270. end;
  271. function TTextStreamFile.GetEOF : Boolean;
  272. begin
  273. Result := fReadStream.EndOfStream;
  274. end;
  275. procedure TTextStreamFile.Close;
  276. begin
  277. if Assigned(fReadStream) then fReadStream.Close;
  278. if Assigned(fWriteStream) then fWriteStream.Close;
  279. end;
  280. {$ENDIF NFPC}
  281. {$IFDEF FPC}
  282. { EFileStreamError }
  283. constructor EFileStreamError.Create(ResStringRec: PResStringRec;
  284. const FileName: string);
  285. begin
  286. {$IFNDEF LINUX}
  287. inherited CreateResFmt(ResStringRec, [ExpandFileName(FileName), SysErrorMessage(GetLastError)]);
  288. {$ELSE}
  289. inherited CreateResFmt(ResStringRec, [ExpandFileName(FileName), SysErrorMessage(errno)]);
  290. {$ENDIF}
  291. end;
  292. { TPath }
  293. class function TPath.GetFileNameWithoutExtension(const FileName: string
  294. ): string;
  295. var
  296. fname : string;
  297. begin
  298. fname := ExtractFileName(FileName);
  299. Result := Copy(fname, 1, Length(fname) - Length(ExtractFileExt(fname)));
  300. end;
  301. class function TPath.ChangeExtension(const Path, NewExtension : string) : string;
  302. var
  303. dot : string;
  304. begin
  305. if NewExtension.Contains('.') then dot := ''
  306. else dot := '.';
  307. Result := TPath.GetFileNameWithoutExtension(Path) + dot + NewExtension;
  308. end;
  309. class function TPath.GetFileName(const aPath: string): string;
  310. begin
  311. Result := ExtractFileName(aPath);
  312. end;
  313. class function TPath.GetDirectoryName(const FileName : string) : string;
  314. begin
  315. Result := ExtractFileDir(Filename);
  316. end;
  317. class procedure TPath.CheckPathLength(const Path: string; const MaxLength: Integer);
  318. begin
  319. {$IFDEF MSWINDOWS}
  320. if (Length(Path) >= MaxLength) then
  321. {$ENDIF MSWINDOWS}
  322. {$IFDEF POSIX}
  323. if (Length(UTF8Encode(Path)) >= MaxLength) then
  324. {$ENDIF POSIX}
  325. raise EPathTooLongException.CreateRes(@SPathTooLong);
  326. end;
  327. class function TPath.GetExtension(const Path : string) : string;
  328. begin
  329. Result := ExtractFileExt(Path);
  330. end;
  331. class function TPath.EndsWithDelimiter(const aPath : string) : Boolean;
  332. var
  333. c : Char;
  334. begin
  335. if aPath = '' then Exit(False);
  336. c := aPath[High(aPath)];
  337. Result := (c = '\') or (c = '/');
  338. end;
  339. class function TPath.Combine(const aPath1, aPath2 : string) : string;
  340. var
  341. delim : string;
  342. begin
  343. delim := '';
  344. if aPath1.Contains('/') then delim := '/'
  345. else if aPath1.Contains('\') then delim := '\';
  346. if delim = '' then
  347. begin
  348. {$IFDEF LINUX}
  349. delim := '/';
  350. {$ELSE}
  351. delim := '\';
  352. {$ENDIF}
  353. end;
  354. if EndsWithDelimiter(aPath1) then
  355. begin
  356. if EndsWithDelimiter(aPath2) then Result := aPath1 + Copy(aPath2,2,aPath2.Length)
  357. else Result := aPath1 + aPath2;
  358. end
  359. else
  360. begin
  361. if EndsWithDelimiter(aPath2) then Result := aPath1 + aPath2
  362. else Result := aPath1 + delim + aPath2;
  363. end;
  364. end;
  365. { TDirectory }
  366. class function TDirectory.Exists(const Path: string; FollowLink: Boolean = True): Boolean;
  367. begin
  368. Result := DirectoryExists(Path);
  369. end;
  370. class function TDirectory.GetDirectories(const Path : string) : TArray<string>;
  371. var
  372. rec : TSearchRec;
  373. begin
  374. if FindFirst(TPath.Combine(Path,'*'),faAnyFile and faDirectory,rec) = 0 then
  375. repeat
  376. if ((rec.Attr and faDirectory) = faDirectory) and (rec.Name <> '.') and (rec.Name <> '..') then
  377. begin
  378. Result := Result + [rec.Name];
  379. end;
  380. until FindNext(rec) <> 0;
  381. SysUtils.FindClose(rec);
  382. end;
  383. { TFile }
  384. class function TFile.Exists(const Path : string) : Boolean;
  385. begin
  386. Result := FileExists(Path);
  387. end;
  388. class procedure TFile.SetCreationTime(const Path: string; const CreationTime: TDateTime);
  389. begin
  390. SetDateTimeInfo(Path,@CreationTime,nil,nil,True);
  391. end;
  392. class procedure TFile.SetLastAccessTime(const Path: string; const LastAccessTime: TDateTime);
  393. begin
  394. SetDateTimeInfo(Path,nil,@LastAccessTime,nil,True);
  395. end;
  396. class procedure TFile.SetLastWriteTime(const Path: string; const LastWriteTime: TDateTime);
  397. begin
  398. SetDateTimeInfo(Path,nil,nil,@LastWriteTime,True);
  399. end;
  400. class function TFile.IsReadOnly(const Path : string) : Boolean;
  401. begin
  402. Result := FileIsReadOnly(Path);
  403. end;
  404. class function TFile.Delete(const Path : string) : Boolean;
  405. begin
  406. Result := DeleteFile(PChar(Path));
  407. end;
  408. class function TFile.Move(const SourceFileName, DestFileName: string) : Boolean;
  409. begin
  410. {$IFNDEF LINUX}
  411. Result := MoveFile(PChar(SourceFileName),PChar(DestFileName));
  412. {$ELSE}
  413. Result := RenameFile(PChar(SourceFileName),PChar(DestFileName));
  414. {$ENDIF}
  415. end;
  416. {$IFNDEF NEXTGEN}
  417. class function TFile.IsInUse(const Path : string) : Boolean;
  418. begin
  419. Result := IsFileInUse(Path);
  420. end;
  421. {$ENDIF}
  422. class function TFile.GetSize(const Path : string) : Int64;
  423. var
  424. f : File of Byte;
  425. begin
  426. Assign(f,Path);
  427. try
  428. Reset (f);
  429. Result := FileSize(f);
  430. finally
  431. CloseFile(f);
  432. end;
  433. end;
  434. class function TFile.GetExtension(const Path : string) : string;
  435. begin
  436. Result := ExtractFileExt(Path);
  437. end;
  438. class function TFile.GetCreationTime(const Path : string) : TDateTime;
  439. begin
  440. Result := Quick.Files.GetCreationTime(Path);
  441. end;
  442. class function TFile.GetLastAccessTime(const Path : string) : TDateTime;
  443. begin
  444. Result := Quick.Files.GetLastAccessTime(Path);
  445. end;
  446. class function TFile.GetLastWriteTime(const Path : string) : TDateTime;
  447. begin
  448. Result := Quick.Files.GetLastWriteTime(Path);
  449. end;
  450. class function TFile.Create(const Path: string; const BufferSize: Integer): TFileStream;
  451. begin
  452. try
  453. Result := TFileStream.Create(Path,fmCreate);
  454. except
  455. on E: EFileStreamError do
  456. raise EInOutError.Create(E.Message);
  457. end;
  458. end;
  459. class function TFile.Create(const Path: string): TFileStream;
  460. begin
  461. Result := Create(Path, 0);
  462. end;
  463. { TStreamWriter }
  464. procedure TStreamWriter.Close;
  465. begin
  466. Flush;
  467. if FOwnsStream then
  468. FreeAndNil(FStream);
  469. end;
  470. constructor TStreamWriter.Create(Stream: TStream);
  471. begin
  472. inherited Create;
  473. FOwnsStream := False;
  474. FStream := Stream;
  475. FEncoding := TEncoding.UTF8;
  476. SetLength(FBuffer, 1024);
  477. FBufferIndex := 0;
  478. FNewLine := sLineBreak;
  479. FAutoFlush := True;
  480. end;
  481. constructor TStreamWriter.Create(Stream: TStream; Encoding: TEncoding; BufferSize: Integer);
  482. begin
  483. inherited Create;
  484. FOwnsStream := False;
  485. FStream := Stream;
  486. FEncoding := Encoding;
  487. if BufferSize >= 128 then
  488. SetLength(FBuffer, BufferSize)
  489. else
  490. SetLength(FBuffer, 128);
  491. FBufferIndex := 0;
  492. FNewLine := sLineBreak;
  493. FAutoFlush := True;
  494. if Stream.Position = 0 then
  495. WriteBytes(FEncoding.GetPreamble);
  496. end;
  497. constructor TStreamWriter.Create(const Filename: string; Append: Boolean);
  498. begin
  499. if (not FileExists(Filename)) or (not Append) then
  500. FStream := TFileStream.Create(Filename, fmCreate)
  501. else
  502. begin
  503. FStream := TFileStream.Create(Filename, fmOpenWrite);
  504. FStream.Seek(0, soEnd);
  505. end;
  506. Create(FStream);
  507. FOwnsStream := True;
  508. end;
  509. constructor TStreamWriter.Create(const Filename: string; Append: Boolean;
  510. Encoding: TEncoding; BufferSize: Integer);
  511. begin
  512. if (not FileExists(Filename)) or (not Append) then
  513. FStream := TFileStream.Create(Filename, fmCreate)
  514. else
  515. begin
  516. FStream := TFileStream.Create(Filename, fmOpenWrite);
  517. FStream.Seek(0, soEnd);
  518. end;
  519. Create(FStream, Encoding, BufferSize);
  520. FOwnsStream := True;
  521. end;
  522. destructor TStreamWriter.Destroy;
  523. begin
  524. Close;
  525. SetLength(FBuffer, 0);
  526. inherited;
  527. end;
  528. procedure TStreamWriter.Flush;
  529. begin
  530. if FBufferIndex = 0 then
  531. Exit;
  532. if FStream = nil then
  533. Exit;
  534. FStream.Write(FBuffer[0], FBufferIndex);
  535. FBufferIndex := 0;
  536. end;
  537. procedure TStreamWriter.OwnStream;
  538. begin
  539. FOwnsStream := True;
  540. end;
  541. procedure TStreamWriter.Write(const Value: string);
  542. begin
  543. WriteBytes(FEncoding.GetBytes(Value));
  544. end;
  545. procedure TStreamWriter.WriteBytes(Bytes: TBytes);
  546. var
  547. ByteIndex: Integer;
  548. WriteLen: Integer;
  549. begin
  550. ByteIndex := 0;
  551. while ByteIndex < Length(Bytes) do
  552. begin
  553. WriteLen := Length(Bytes) - ByteIndex;
  554. if WriteLen > Length(FBuffer) - FBufferIndex then
  555. WriteLen := Length(FBuffer) - FBufferIndex;
  556. Move(Bytes[ByteIndex], FBuffer[FBufferIndex], WriteLen);
  557. Inc(FBufferIndex, WriteLen);
  558. Inc(ByteIndex, WriteLen);
  559. if FBufferIndex >= Length(FBuffer) then
  560. Flush;
  561. end;
  562. if FAutoFlush then
  563. Flush;
  564. end;
  565. procedure TStreamWriter.Write(const aFormat: string; Args: array of const);
  566. begin
  567. WriteBytes(FEncoding.GetBytes(Format(aFormat, Args)));
  568. end;
  569. procedure TStreamWriter.Write(Value: Single);
  570. begin
  571. WriteBytes(FEncoding.GetBytes(FloatToStr(Value)));
  572. end;
  573. procedure TStreamWriter.Write(Value: Double);
  574. begin
  575. WriteBytes(FEncoding.GetBytes(FloatToStr(Value)));
  576. end;
  577. procedure TStreamWriter.Write(Value: Integer);
  578. begin
  579. WriteBytes(FEncoding.GetBytes(IntToStr(Value)));
  580. end;
  581. procedure TStreamWriter.Write(Value: Char);
  582. begin
  583. WriteBytes(FEncoding.GetBytes(Value));
  584. end;
  585. procedure TStreamWriter.Write(Value: TObject);
  586. begin
  587. WriteBytes(FEncoding.GetBytes(Value.ToString));
  588. end;
  589. procedure TStreamWriter.Write(Value: Int64);
  590. begin
  591. WriteBytes(FEncoding.GetBytes(IntToStr(Value)));
  592. end;
  593. procedure TStreamWriter.Write(Value: Boolean);
  594. begin
  595. WriteBytes(FEncoding.GetBytes(BoolToStr(Value, True)));
  596. end;
  597. procedure TStreamWriter.WriteLine(Value: Double);
  598. begin
  599. WriteBytes(FEncoding.GetBytes(FloatToStr(Value) + FNewLine));
  600. end;
  601. procedure TStreamWriter.WriteLine(Value: Integer);
  602. begin
  603. WriteBytes(FEncoding.GetBytes(IntToStr(Value) + FNewLine));
  604. end;
  605. procedure TStreamWriter.WriteLine;
  606. begin
  607. WriteBytes(FEncoding.GetBytes(FNewLine));
  608. end;
  609. procedure TStreamWriter.WriteLine(Value: Boolean);
  610. begin
  611. WriteBytes(FEncoding.GetBytes(BoolToStr(Value, True) + FNewLine));
  612. end;
  613. procedure TStreamWriter.WriteLine(Value: Char);
  614. begin
  615. WriteBytes(FEncoding.GetBytes(Value));
  616. WriteBytes(FEncoding.GetBytes(FNewLine));
  617. end;
  618. procedure TStreamWriter.WriteLine(Value: Int64);
  619. begin
  620. WriteBytes(FEncoding.GetBytes(IntToStr(Value) + FNewLine));
  621. end;
  622. procedure TStreamWriter.WriteLine(const aFormat: string; Args: array of const);
  623. begin
  624. WriteBytes(FEncoding.GetBytes(Format(aFormat, Args) + FNewLine));
  625. end;
  626. procedure TStreamWriter.WriteLine(Value: TObject);
  627. begin
  628. WriteBytes(FEncoding.GetBytes(Value.ToString + FNewLine));
  629. end;
  630. procedure TStreamWriter.WriteLine(Value: Single);
  631. begin
  632. WriteBytes(FEncoding.GetBytes(FloatToStr(Value) + FNewLine));
  633. end;
  634. procedure TStreamWriter.WriteLine(const Value: string);
  635. begin
  636. WriteBytes(FEncoding.GetBytes(Value + FNewLine));
  637. end;
  638. {$ENDIF FPC}
  639. {other functions}
  640. function CreateDummyFile(const aFilename : string; const aSize : Int64 ) : Boolean;
  641. var
  642. fs : TFileStream;
  643. i : Integer;
  644. buf : string;
  645. Begin
  646. fs := TFileStream.Create(aFilename,fmCreate);
  647. buf := 'A';
  648. try
  649. fs.Seek(0, soBeginning);
  650. for i := 0 to aSize do fs.Write(buf[1], Length(buf));
  651. finally
  652. fs.Free;
  653. end;
  654. Result := FileExists(aFilename);
  655. End;
  656. procedure SplitFile(const aFileName : string; aSplitByteSize : Int64);
  657. var
  658. fs, ss: TFileStream;
  659. cnt : integer;
  660. splitname: string;
  661. begin
  662. fs := TFileStream.Create(aFileName, fmOpenRead or fmShareDenyWrite) ;
  663. try
  664. for cnt := 1 to Trunc(fs.Size / aSplitByteSize) + 1 do
  665. begin
  666. splitname := ChangeFileExt(aFileName, Format('%s%.3d', ['.',cnt])) ;
  667. ss := TFileStream.Create(splitname, fmCreate or fmShareExclusive) ;
  668. try
  669. if fs.Size - fs.Position < aSplitByteSize then
  670. aSplitByteSize := fs.Size - fs.Position;
  671. ss.CopyFrom(fs, aSplitByteSize) ;
  672. finally
  673. ss.Free;
  674. end;
  675. end;
  676. finally
  677. fs.Free;
  678. end;
  679. end;
  680. procedure MergeFiles(const aFirstSplitFileName, aOutFileName : string);
  681. var
  682. fs, ss: TFileStream;
  683. cnt: integer;
  684. splitfilename : string;
  685. begin
  686. cnt := 1;
  687. splitfilename := aFirstSplitFileName;
  688. fs := TFileStream.Create(aOutFileName, fmCreate or fmShareExclusive) ;
  689. try
  690. while FileExists(splitfilename) do
  691. begin
  692. ss := TFileStream.Create(splitfilename, fmOpenRead or fmShareDenyWrite) ;
  693. try
  694. fs.CopyFrom(ss, 0) ;
  695. finally
  696. ss.Free;
  697. end;
  698. Inc(cnt) ;
  699. splitfilename := ChangeFileExt(aFirstSplitFileName, Format('%s%.3d', ['.',cnt])) ;
  700. end;
  701. finally
  702. fs.Free;
  703. end;
  704. end;
  705. procedure MergeFiles(aFilenames : array of string; const aOutFileName : string);
  706. var
  707. filename : string;
  708. fs,
  709. ss : TFileStream;
  710. begin
  711. fs := TFileStream.Create(aOutFileName,fmCreate or fmShareExclusive) ;
  712. try
  713. for filename in aFilenames do
  714. begin
  715. if not FileExists(filename) then raise Exception.CreateFmt('Merge file %s not found!',[filename]);
  716. ss := TFileStream.Create(filename, fmOpenRead or fmShareDenyWrite) ;
  717. try
  718. fs.CopyFrom(ss,0);
  719. finally
  720. ss.Free;
  721. end;
  722. end;
  723. finally
  724. fs.Free;
  725. end;
  726. end;
  727. function IsFileInUse(const aFileName : string) : Boolean;
  728. {$IF NOT Defined(LINUX) AND NOT Defined(MACOS) AND NOT Defined(ANDROID)}
  729. var
  730. HFileRes: HFILE;
  731. begin
  732. Result := False;
  733. if not FileExists(aFileName) then Exit;
  734. try
  735. HFileRes := CreateFile(PChar(aFileName),
  736. GENERIC_READ or GENERIC_WRITE
  737. ,0
  738. ,nil
  739. ,OPEN_EXISTING
  740. ,FILE_ATTRIBUTE_NORMAL
  741. ,0);
  742. Result := (HFileRes = INVALID_HANDLE_VALUE);
  743. if not(Result) then begin
  744. CloseHandle(HFileRes);
  745. end;
  746. except
  747. Result := True;
  748. end;
  749. end;
  750. {$ELSE}
  751. var
  752. fs : TFileStream;
  753. begin
  754. try
  755. fs := TFileStream.Create(aFileName, fmOpenReadWrite, fmShareExclusive);
  756. Result := True;
  757. fs.Free;
  758. except
  759. Result := False;
  760. end;
  761. end;
  762. {$ENDIF}
  763. procedure FileReplaceText(const aFileName, aSearchText, AReplaceText : string);
  764. var
  765. fs: TFileStream;
  766. S: string;
  767. begin
  768. fs := TFileStream.Create(aFileName, fmOpenread or fmShareDenyNone);
  769. try
  770. SetLength(S, fs.Size);
  771. fs.ReadBuffer(S[1], fs.Size);
  772. finally
  773. fs.Free;
  774. end;
  775. S := StringReplace(S, aSearchText, AReplaceText, [rfReplaceAll, rfIgnoreCase]);
  776. fs := TFileStream.Create(aFileName, fmCreate);
  777. try
  778. fs.WriteBuffer(S[1], Length(S));
  779. finally
  780. fs.Free;
  781. end;
  782. end;
  783. {$IFNDEF NEXTGEN}
  784. function FileSearchText(const aFileName, SearchText: string; caseSensitive : Boolean): Longint;
  785. const
  786. BufferSize = $8001;
  787. var
  788. pBuf, pEnd, pScan, pPos: PAnsiChar;
  789. filesize: LongInt;
  790. bytesRemaining: LongInt;
  791. bytesToRead: Integer;
  792. F: file;
  793. SearchFor: PAnsiChar;
  794. oldMode: Word;
  795. begin
  796. Result := -1;
  797. if (Length(SearchText) = 0) or (Length(aFileName) = 0) then Exit;
  798. SearchFor := nil;
  799. pBuf := nil;
  800. AssignFile(F, aFileName);
  801. oldMode := FileMode;
  802. FileMode := 0;
  803. Reset(F, 1);
  804. FileMode := oldMode;
  805. try
  806. {$IFDEF FPC}
  807. SearchFor := PChar(StrAlloc(Length(SearchText) + 1));
  808. {$ELSE}
  809. {$IFDEF DELPHI2010_UP}
  810. SearchFor := PAnsiChar(StrAlloc(Length(SearchText) + 1));
  811. {$ELSE}
  812. SearchFor := StrAlloc(Length(SearchText) + 1);
  813. {$ENDIF}
  814. {$ENDIF FPC}
  815. StrPCopy(SearchFor, SearchText);
  816. {$IFDEF FPC}
  817. if not caseSensitive then UpperCase(SearchFor);
  818. {$ELSE}
  819. if not caseSensitive then AnsiUpperCase(SearchFor);
  820. {$ENDIF}
  821. GetMem(pBuf, BufferSize);
  822. filesize := System.Filesize(F);
  823. bytesRemaining := filesize;
  824. pPos := nil;
  825. while bytesRemaining > 0 do
  826. begin
  827. if bytesRemaining >= BufferSize then bytesToRead := Pred(BufferSize)
  828. else bytesToRead := bytesRemaining;
  829. BlockRead(F, pBuf^, bytesToRead, bytesToRead);
  830. pEnd := @pBuf[bytesToRead];
  831. pEnd^ := #0;
  832. pScan := pBuf;
  833. while pScan < pEnd do
  834. begin
  835. {$IFDEF FPC}
  836. if not caseSensitive then UpperCase(pScan);
  837. {$ELSE}
  838. if not caseSensitive then AnsiUpperCase(pScan);
  839. {$ENDIF}
  840. pPos := StrPos(pScan, SearchFor);
  841. if pPos <> nil then
  842. begin
  843. Result := FileSize - bytesRemaining +
  844. Longint(pPos) - Longint(pBuf);
  845. Break;
  846. end;
  847. pScan := StrEnd(pScan);
  848. Inc(pScan);
  849. end;
  850. if pPos <> nil then Break;
  851. bytesRemaining := bytesRemaining - bytesToRead;
  852. if bytesRemaining > 0 then
  853. begin
  854. Seek(F, FilePos(F) - Length(SearchText));
  855. bytesRemaining := bytesRemaining + Length(SearchText);
  856. end;
  857. end;
  858. finally
  859. CloseFile(F);
  860. if SearchFor <> nil then StrDispose(SearchFor);
  861. if pBuf <> nil then FreeMem(pBuf, BufferSize);
  862. end;
  863. end;
  864. {$ENDIF}
  865. {$IFDEF MSWINDOWS}
  866. function GetLastAccessTime(const aFileName: string): TDateTime;
  867. var
  868. ffd: TWin32FindData;
  869. dft: DWORD;
  870. lft: TFileTime;
  871. h: THandle;
  872. begin
  873. Result := 0;
  874. {$IFDEF FPC}
  875. h := FindFirstFile(PAnsiChar(aFileName), ffd);
  876. {$ELSE}
  877. h := FindFirstFile(PChar(aFileName), ffd);
  878. {$ENDIF}
  879. if (INVALID_HANDLE_VALUE <> h) then
  880. begin
  881. FindClose(h);
  882. FileTimeToLocalFileTime(ffd.ftLastAccessTime, lft);
  883. FileTimeToDosDateTime(lft, LongRec(dft).Hi, LongRec(dft).Lo);
  884. Result := FileDateToDateTime(dft);
  885. end;
  886. end;
  887. function GetCreationTime(const aFilename : string): TDateTime;
  888. var
  889. ffd: TWin32FindData;
  890. dft: DWORD;
  891. lft: TFileTime;
  892. h: THandle;
  893. begin
  894. Result := 0;
  895. {$IFDEF FPC}
  896. h := FindFirstFile(PAnsiChar(aFileName), ffd);
  897. {$ELSE}
  898. h := FindFirstFile(PChar(aFileName), ffd);
  899. {$ENDIF}
  900. if (INVALID_HANDLE_VALUE <> h) then
  901. begin
  902. FindClose(h);
  903. FileTimeToLocalFileTime(ffd.ftCreationTime, lft);
  904. FileTimeToDosDateTime(lft, LongRec(dft).Hi, LongRec(dft).Lo);
  905. Result := FileDateToDateTime(dft);
  906. end;
  907. end;
  908. function GetLastWriteTime(const aFileName : string): TDateTime;
  909. var
  910. ffd: TWin32FindData;
  911. dft: DWORD;
  912. lft: TFileTime;
  913. h: THandle;
  914. begin
  915. Result := 0;
  916. {$IFDEF FPC}
  917. h := FindFirstFile(PAnsiChar(aFileName), ffd);
  918. {$ELSE}
  919. h := FindFirstFile(PChar(aFileName), ffd);
  920. {$ENDIF}
  921. if (INVALID_HANDLE_VALUE <> h) then
  922. begin
  923. FindClose(h);
  924. FileTimeToLocalFileTime(ffd.ftLastWriteTime, lft);
  925. FileTimeToDosDateTime(lft, LongRec(dft).Hi, LongRec(dft).Lo);
  926. Result := FileDateToDateTime(dft);
  927. end;
  928. end;
  929. {$ELSE}
  930. {$IFDEF FPC} //FPC Linux
  931. function GetLastAccessTime(const aFileName: string): TDateTime;
  932. var
  933. info : stat;
  934. begin
  935. Result := 0;
  936. if fpstat(aFileName,info) <> 0 then
  937. begin
  938. Result := info.st_atime;
  939. end;
  940. end;
  941. function GetCreationTime(const aFilename : string): TDateTime;
  942. var
  943. info : stat;
  944. begin
  945. Result := 0;
  946. if fpstat(aFileName,info) <> 0 then
  947. begin
  948. Result := info.st_ctime;
  949. end;
  950. end;
  951. function GetLastWriteTime(const aFileName : string): TDateTime;
  952. var
  953. info : stat;
  954. begin
  955. Result := 0;
  956. if fpstat(aFileName,info) <> 0 then
  957. begin
  958. Result := info.st_mtime;
  959. end;
  960. end;
  961. {$ELSE} //Delphi Nextgen & Linux
  962. function GetLastAccessTime(const aFileName: string): TDateTime;
  963. var
  964. info : TDateTimeInfoRec;
  965. begin
  966. if FileGetDateTimeInfo(aFileName,info,True) then Result := info.LastAccessTime
  967. else Result := 0.0;
  968. end;
  969. function GetCreationTime(const aFilename : string): TDateTime;
  970. var
  971. info : TDateTimeInfoRec;
  972. begin
  973. if FileGetDateTimeInfo(aFileName,info,True) then Result := info.CreationTime
  974. else Result := 0.0;
  975. end;
  976. function GetLastWriteTime(const aFileName : string): TDateTime;
  977. var
  978. info : TDateTimeInfoRec;
  979. begin
  980. if FileGetDateTimeInfo(aFileName,info,True) then Result := info.TimeStamp
  981. else Result := 0.0;
  982. end;
  983. {$ENDIF}
  984. {$ENDIF}
  985. {$IFDEF FPC}
  986. function FindDelimiter(const Delimiters, S: string; StartIdx: Integer = 1): Integer;
  987. var
  988. Stop: Boolean;
  989. Len: Integer;
  990. begin
  991. Result := 0;
  992. Len := S.Length;
  993. Stop := False;
  994. while (not Stop) and (StartIdx <= Len) do
  995. if IsDelimiter(Delimiters, S, StartIdx) then
  996. begin
  997. Result := StartIdx;
  998. Stop := True;
  999. end
  1000. else
  1001. Inc(StartIdx);
  1002. end;
  1003. {$ENDIF}
  1004. {$IFDEF MSWINDOWS}
  1005. function ConvertDateTimeToFileTime(const DateTime: TDateTime; const UseLocalTimeZone: Boolean): TFileTime;
  1006. var
  1007. LFileTime: TFileTime;
  1008. SysTime: TSystemTime;
  1009. begin
  1010. Result.dwLowDateTime := 0;
  1011. Result.dwLowDateTime := 0;
  1012. DecodeDateTime(DateTime, SysTime.wYear, SysTime.wMonth, SysTime.wDay,
  1013. SysTime.wHour, SysTime.wMinute, SysTime.wSecond, SysTime.wMilliseconds);
  1014. if SystemTimeToFileTime(SysTime, LFileTime) then
  1015. if UseLocalTimeZone then
  1016. LocalFileTimeToFileTime(LFileTime, Result)
  1017. else
  1018. Result := LFileTime;
  1019. end;
  1020. function ConvertFileTimeToDateTime(const FileTime : TFileTime; const UseLocalTimeZone : Boolean) : TDateTime;
  1021. var
  1022. dft: DWORD;
  1023. lft: TFileTime;
  1024. begin
  1025. FileTimeToLocalFileTime(FileTime, lft);
  1026. FileTimeToDosDateTime(lft, LongRec(dft).Hi, LongRec(dft).Lo);
  1027. Result := FileDateToDateTime(dft);
  1028. end;
  1029. {$ENDIF}
  1030. {$If Defined(FPC) AND Defined(LINUX)}
  1031. function ConvertDateTimeToFileTime(const DateTime: TDateTime; const UseLocalTimeZone: Boolean): TFileTime;
  1032. begin
  1033. { Use the time zone if necessary }
  1034. if not UseLocalTimeZone then
  1035. Result := DateTimeToFileDate(DateTime)
  1036. else
  1037. Result := DateTimeToFileDate(DateTime);
  1038. end;
  1039. {$ENDIF}
  1040. {$IFDEF POSIX}
  1041. function ConvertDateTimeToFileTime(const DateTime: TDateTime; const UseLocalTimeZone: Boolean): TFileTime;
  1042. begin
  1043. { Use the time zone if necessary }
  1044. if not UseLocalTimeZone then
  1045. Result := DateTimeToFileDate(TTimeZone.Local.ToLocalTime(DateTime))
  1046. else
  1047. Result := DateTimeToFileDate(DateTime);
  1048. end;
  1049. {$ENDIF}
  1050. procedure SetDateTimeInfo(const Path: string; const CreationTime, LastAccessTime, LastWriteTime: PDateTime; const UseLocalTimeZone: Boolean);
  1051. {$IFDEF MSWINDOWS}
  1052. var
  1053. LFileHnd: THandle;
  1054. LFileAttr: Cardinal;
  1055. LFileCreationTime: PFileTime;
  1056. LFileLastAccessTime: PFileTime;
  1057. LFileLastWriteTime: PFileTime;
  1058. begin
  1059. // establish what date-times must be set to the directory
  1060. LFileHnd := 0;
  1061. LFileCreationTime := nil;
  1062. LFileLastAccessTime := nil;
  1063. LFileLastWriteTime := nil;
  1064. try
  1065. try
  1066. if Assigned(CreationTime) then
  1067. begin
  1068. New(LFileCreationTime);
  1069. LFileCreationTime^ := ConvertDateTimeToFileTime(CreationTime^, UseLocalTimeZone);
  1070. end;
  1071. if Assigned(LastAccessTime) then
  1072. begin
  1073. New(LFileLastAccessTime);
  1074. LFileLastAccessTime^ := ConvertDateTimeToFileTime(LastAccessTime^, UseLocalTimeZone);
  1075. end;
  1076. if Assigned(LastWriteTime) then
  1077. begin
  1078. New(LFileLastWriteTime);
  1079. LFileLastWriteTime^ := ConvertDateTimeToFileTime(LastWriteTime^, UseLocalTimeZone);
  1080. end;
  1081. // determine if Path points to a directory or a file
  1082. SetLastError(ERROR_SUCCESS);
  1083. LFileAttr := FileGetAttr(Path);
  1084. if LFileAttr and faDirectory <> 0 then
  1085. LFileAttr := FILE_FLAG_BACKUP_SEMANTICS
  1086. else
  1087. LFileAttr := FILE_ATTRIBUTE_NORMAL;
  1088. // set the new date-times to the directory or file
  1089. LFileHnd := CreateFile(PChar(Path), GENERIC_WRITE, FILE_SHARE_WRITE, nil,
  1090. OPEN_EXISTING, LFileAttr, 0);
  1091. if LFileHnd <> INVALID_HANDLE_VALUE then
  1092. SetFileTime(LFileHnd, LFileCreationTime, LFileLastAccessTime, LFileLastWriteTime);
  1093. except
  1094. on E: EConvertError do
  1095. raise EArgumentOutOfRangeException.Create(E.Message);
  1096. end;
  1097. finally
  1098. CloseHandle(LFileHnd);
  1099. SetLastError(ERROR_SUCCESS);
  1100. Dispose(LFileCreationTime);
  1101. Dispose(LFileLastAccessTime);
  1102. Dispose(LFileLastWriteTime);
  1103. end;
  1104. end;
  1105. {$ENDIF}
  1106. {$IFDEF POSIX}
  1107. var
  1108. LFileName: Pointer;
  1109. LStatBuf: _stat;
  1110. LBuf: utimbuf;
  1111. ErrCode: Integer;
  1112. M: TMarshaller;
  1113. begin
  1114. { Do nothing if no date/time passed. Ignore CreationTime. Unixes do not support creation times for files. }
  1115. if (LastAccessTime = nil) and (LastWriteTime = nil) then
  1116. Exit;
  1117. LFileName := M.AsAnsi(Path, CP_UTF8).ToPointer;
  1118. { Obtain the file times. lstat may fail }
  1119. if ((LastAccessTime = nil) or (LastWriteTime = nil)) then
  1120. begin
  1121. ErrCode := stat(LFileName, LStatBuf);
  1122. { Fail if we can't access the file properly }
  1123. if ErrCode <> 0 then
  1124. Exit; // Fail here prematurely. Do not chnage file times if we failed to fetch the old ones.
  1125. end;
  1126. try
  1127. { Preserve of set the new value }
  1128. if LastAccessTime <> nil then
  1129. LBuf.actime := ConvertDateTimeToFileTime(LastAccessTime^, UseLocalTimeZone)
  1130. else
  1131. LBuf.actime := LStatBuf.st_atime;
  1132. { Preserve of set the new value }
  1133. if LastWriteTime <> nil then
  1134. LBuf.modtime := ConvertDateTimeToFileTime(LastWriteTime^, UseLocalTimeZone)
  1135. else
  1136. LBuf.modtime := LStatBuf.st_mtime;
  1137. { Call utime to set the file times }
  1138. utime(LFileName, LBuf);
  1139. except
  1140. on E: EConvertError do // May rise in ConvertDateTimeToFileTime
  1141. raise EArgumentOutOfRangeException.Create(E.Message);
  1142. end;
  1143. end;
  1144. {$ENDIF}
  1145. {$if Defined(FPC) AND Defined(LINUX)}
  1146. begin
  1147. end;
  1148. {$ENDIF}
  1149. function GetFiles(const Path : string; Recursive : Boolean) : TArray<TDirItem>;
  1150. var
  1151. rec : TSearchRec;
  1152. diritem : TDirItem;
  1153. begin
  1154. if FindFirst(IncludeTrailingPathDelimiter(Path) + '*', faAnyFile, rec) = 0 then
  1155. try
  1156. repeat
  1157. if (rec.Attr and faDirectory) <> faDirectory then
  1158. begin
  1159. diritem.Name := rec.Name;
  1160. diritem.IsDirectory := False;
  1161. diritem.Size := rec.Size;
  1162. diritem.CreationDate := ConvertFileTimeToDateTime(rec.FindData.ftCreationTime,True);
  1163. diritem.LastModified := ConvertFileTimeToDateTime(rec.FindData.ftLastWriteTime,True);
  1164. Result := Result + [diritem];
  1165. end
  1166. else
  1167. begin
  1168. if Recursive then Result := Result + GetFiles(IncludeTrailingPathDelimiter(Path) + diritem.Name,Recursive);
  1169. end;
  1170. until FindNext(rec) <> 0;
  1171. finally
  1172. SysUtils.FindClose(rec);
  1173. end;
  1174. end;
  1175. function GetDirectories(const Path : string; Recursive : Boolean) : TArray<TDirItem>;
  1176. var
  1177. rec : TSearchRec;
  1178. diritem : TDirItem;
  1179. begin
  1180. if FindFirst(IncludeTrailingPathDelimiter(Path) + '*', faAnyFile, rec) = 0 then
  1181. try
  1182. repeat
  1183. if ((rec.Attr and faDirectory) = faDirectory) and (rec.Name <> '.') and (rec.Name <> '..') then
  1184. begin
  1185. diritem.Name := rec.Name;
  1186. diritem.IsDirectory := True;
  1187. diritem.Size := rec.Size;
  1188. diritem.CreationDate := ConvertFileTimeToDateTime(rec.FindData.ftCreationTime,True);
  1189. diritem.LastModified := ConvertFileTimeToDateTime(rec.FindData.ftLastWriteTime,True);
  1190. Result := Result + [diritem];
  1191. if Recursive then Result := Result + GetFiles(IncludeTrailingPathDelimiter(Path) + diritem.Name,Recursive);
  1192. end;
  1193. until FindNext(rec) <> 0;
  1194. finally
  1195. SysUtils.FindClose(rec);
  1196. end;
  1197. end;
  1198. function GetFilesAndDirectories(const Path : string; Recursive : Boolean) : TArray<TDirItem>;
  1199. var
  1200. rec : TSearchRec;
  1201. diritem : TDirItem;
  1202. begin
  1203. if FindFirst(IncludeTrailingPathDelimiter(Path) + '*', faAnyFile, rec) = 0 then
  1204. try
  1205. repeat
  1206. if (rec.Attr and faDirectory) <> faDirectory then
  1207. begin
  1208. diritem.Name := rec.Name;
  1209. diritem.IsDirectory := False;
  1210. diritem.Size := rec.Size;
  1211. diritem.CreationDate := ConvertFileTimeToDateTime(rec.FindData.ftCreationTime,True);
  1212. diritem.LastModified := ConvertFileTimeToDateTime(rec.FindData.ftLastWriteTime,True);
  1213. Result := Result + [diritem];
  1214. end
  1215. else if (rec.Name <> '.') and (rec.Name <> '..') then
  1216. begin
  1217. diritem.Name := rec.Name;
  1218. diritem.IsDirectory := True;
  1219. diritem.Size := rec.Size;
  1220. diritem.CreationDate := ConvertFileTimeToDateTime(rec.FindData.ftCreationTime,True);
  1221. diritem.LastModified := ConvertFileTimeToDateTime(rec.FindData.ftLastWriteTime,True);
  1222. Result := Result + [diritem];
  1223. if Recursive then Result := Result + GetFiles(IncludeTrailingPathDelimiter(Path) + diritem.Name,Recursive);
  1224. end;
  1225. until FindNext(rec) <> 0;
  1226. finally
  1227. SysUtils.FindClose(rec);
  1228. end;
  1229. end;
  1230. end.