2
0

Quick.Files.pas 42 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505
  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 : 16/11/2020
  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. {$IFNDEF FPC}
  215. TDirItemAddProc = reference to procedure(const diritem : TDirItem);
  216. {$ELSE}
  217. TDirItemAddProc = procedure(const diritem : TDirItem);
  218. {$ENDIF}
  219. function CreateDummyFile(const aFilename : string; const aSize : Int64) : Boolean;
  220. procedure SplitFile(const aFileName : string; aSplitByteSize : Int64);
  221. procedure MergeFiles(const aFirstSplitFileName, aOutFileName : string); overload;
  222. procedure MergeFiles(aFilenames : array of string; const aOutFileName : string); overload;
  223. {$IFNDEF NEXTGEN}
  224. function IsFileInUse(const aFileName : string) : Boolean;
  225. {$ENDIF}
  226. procedure FileReplaceText(const aFileName, aSearchText, AReplaceText : string);
  227. {$IFNDEF NEXTGEN}
  228. function FileSearchText(const aFileName, SearchText: string; caseSensitive : Boolean): Longint;
  229. {$ENDIF}
  230. function GetCreationTime(const aFilename : string): TDateTime;
  231. function GetLastAccessTime(const aFileName: string): TDateTime;
  232. function GetLastWriteTime(const aFileName : string): TDateTime;
  233. {$IFDEF FPC}
  234. function FindDelimiter(const Delimiters, S: string; StartIdx: Integer = 1): Integer;
  235. {$ENDIF}
  236. function ConvertDateTimeToFileTime(const DateTime: TDateTime; const UseLocalTimeZone: Boolean): TFileTime;
  237. {$IFDEF MSWINDOWS}
  238. function ConvertFileTimeToDateTime(const FileTime : TFileTime; const UseLocalTimeZone : Boolean) : TDateTime;
  239. {$ENDIF}
  240. procedure SetDateTimeInfo(const Path: string; const CreationTime, LastAccessTime, LastWriteTime: PDateTime; const UseLocalTimeZone: Boolean);
  241. function GetFiles(const Path : string; Recursive : Boolean) : TArray<TDirItem>; overload;
  242. procedure GetFiles(const Path : string; aAddToList : TDirItemAddProc; Recursive : Boolean); overload;
  243. function GetDirectories(const Path : string; Recursive : Boolean) : TArray<TDirItem>;
  244. function GetFilesAndDirectories(const Path : string; Recursive : Boolean) : TArray<TDirItem>; overload;
  245. procedure GetFilesAndDirectories(const Path : string; aAddToList : TDirItemAddProc; Recursive : Boolean); overload;
  246. implementation
  247. { TTextStreamFile }
  248. {$IFNDEF FPC}
  249. constructor TTextStreamFile.Create(const aFileName : string; aOpenMode : TTextFileOperation);
  250. var
  251. Append : Boolean;
  252. begin
  253. if aOpenMode = tfOpenRead then fReadStream := TStreamReader.Create(aFileName,True)
  254. else
  255. begin
  256. if aOpenMode = tfOpenAppend then Append := True
  257. else Append := False;
  258. fWriteStream := TStreamWriter.Create(aFileName,Append);
  259. end;
  260. end;
  261. destructor TTextStreamFile.Destroy;
  262. begin
  263. if Assigned(fReadStream) then fReadStream.Free;
  264. if Assigned(fWriteStream) then fWriteStream.Free;
  265. inherited Destroy;
  266. end;
  267. function TTextStreamFile.ReadLn(out Data: string): Boolean;
  268. begin
  269. Data := fReadStream.ReadLine;
  270. Result := Data <> '';
  271. end;
  272. function TTextStreamFile.ReadLn: string;
  273. begin
  274. Result := fReadStream.ReadLine;
  275. end;
  276. procedure TTextStreamFile.WriteLn (const Data : string);
  277. begin
  278. fWriteStream.WriteLine(Data);
  279. end;
  280. function TTextStreamFile.GetEOF : Boolean;
  281. begin
  282. Result := fReadStream.EndOfStream;
  283. end;
  284. procedure TTextStreamFile.Close;
  285. begin
  286. if Assigned(fReadStream) then fReadStream.Close;
  287. if Assigned(fWriteStream) then fWriteStream.Close;
  288. end;
  289. {$ENDIF NFPC}
  290. {$IFDEF FPC}
  291. { EFileStreamError }
  292. constructor EFileStreamError.Create(ResStringRec: PResStringRec;
  293. const FileName: string);
  294. begin
  295. {$IFNDEF LINUX}
  296. inherited CreateResFmt(ResStringRec, [ExpandFileName(FileName), SysErrorMessage(GetLastError)]);
  297. {$ELSE}
  298. inherited CreateResFmt(ResStringRec, [ExpandFileName(FileName), SysErrorMessage(errno)]);
  299. {$ENDIF}
  300. end;
  301. { TPath }
  302. class function TPath.GetFileNameWithoutExtension(const FileName: string
  303. ): string;
  304. var
  305. fname : string;
  306. begin
  307. fname := ExtractFileName(FileName);
  308. Result := Copy(fname, 1, Length(fname) - Length(ExtractFileExt(fname)));
  309. end;
  310. class function TPath.ChangeExtension(const Path, NewExtension : string) : string;
  311. var
  312. dot : string;
  313. begin
  314. if NewExtension.Contains('.') then dot := ''
  315. else dot := '.';
  316. Result := TPath.GetFileNameWithoutExtension(Path) + dot + NewExtension;
  317. end;
  318. class function TPath.GetFileName(const aPath: string): string;
  319. begin
  320. Result := ExtractFileName(aPath);
  321. end;
  322. class function TPath.GetDirectoryName(const FileName : string) : string;
  323. begin
  324. Result := ExtractFileDir(Filename);
  325. end;
  326. class procedure TPath.CheckPathLength(const Path: string; const MaxLength: Integer);
  327. begin
  328. {$IFDEF MSWINDOWS}
  329. if (Length(Path) >= MaxLength) then
  330. {$ENDIF MSWINDOWS}
  331. {$IFDEF POSIX}
  332. if (Length(UTF8Encode(Path)) >= MaxLength) then
  333. {$ENDIF POSIX}
  334. raise EPathTooLongException.CreateRes(@SPathTooLong);
  335. end;
  336. class function TPath.GetExtension(const Path : string) : string;
  337. begin
  338. Result := ExtractFileExt(Path);
  339. end;
  340. class function TPath.EndsWithDelimiter(const aPath : string) : Boolean;
  341. var
  342. c : Char;
  343. begin
  344. if aPath = '' then Exit(False);
  345. c := aPath[High(aPath)];
  346. Result := (c = '\') or (c = '/');
  347. end;
  348. class function TPath.Combine(const aPath1, aPath2 : string) : string;
  349. var
  350. delim : string;
  351. begin
  352. delim := '';
  353. if aPath1.Contains('/') then delim := '/'
  354. else if aPath1.Contains('\') then delim := '\';
  355. if delim = '' then
  356. begin
  357. {$IFDEF LINUX}
  358. delim := '/';
  359. {$ELSE}
  360. delim := '\';
  361. {$ENDIF}
  362. end;
  363. if EndsWithDelimiter(aPath1) then
  364. begin
  365. if EndsWithDelimiter(aPath2) then Result := aPath1 + Copy(aPath2,2,aPath2.Length)
  366. else Result := aPath1 + aPath2;
  367. end
  368. else
  369. begin
  370. if EndsWithDelimiter(aPath2) then Result := aPath1 + aPath2
  371. else Result := aPath1 + delim + aPath2;
  372. end;
  373. end;
  374. { TDirectory }
  375. class function TDirectory.Exists(const Path: string; FollowLink: Boolean = True): Boolean;
  376. begin
  377. Result := DirectoryExists(Path);
  378. end;
  379. class function TDirectory.GetDirectories(const Path : string) : TArray<string>;
  380. var
  381. rec : TSearchRec;
  382. begin
  383. if FindFirst(TPath.Combine(Path,'*'),faAnyFile and faDirectory,rec) = 0 then
  384. repeat
  385. if ((rec.Attr and faDirectory) = faDirectory) and (rec.Name <> '.') and (rec.Name <> '..') then
  386. begin
  387. Result := Result + [rec.Name];
  388. end;
  389. until FindNext(rec) <> 0;
  390. SysUtils.FindClose(rec);
  391. end;
  392. { TFile }
  393. class function TFile.Exists(const Path : string) : Boolean;
  394. begin
  395. Result := FileExists(Path);
  396. end;
  397. class procedure TFile.SetCreationTime(const Path: string; const CreationTime: TDateTime);
  398. begin
  399. SetDateTimeInfo(Path,@CreationTime,nil,nil,True);
  400. end;
  401. class procedure TFile.SetLastAccessTime(const Path: string; const LastAccessTime: TDateTime);
  402. begin
  403. SetDateTimeInfo(Path,nil,@LastAccessTime,nil,True);
  404. end;
  405. class procedure TFile.SetLastWriteTime(const Path: string; const LastWriteTime: TDateTime);
  406. begin
  407. SetDateTimeInfo(Path,nil,nil,@LastWriteTime,True);
  408. end;
  409. class function TFile.IsReadOnly(const Path : string) : Boolean;
  410. begin
  411. Result := FileIsReadOnly(Path);
  412. end;
  413. class function TFile.Delete(const Path : string) : Boolean;
  414. begin
  415. Result := DeleteFile(PChar(Path));
  416. end;
  417. class function TFile.Move(const SourceFileName, DestFileName: string) : Boolean;
  418. begin
  419. {$IFNDEF LINUX}
  420. Result := MoveFile(PChar(SourceFileName),PChar(DestFileName));
  421. {$ELSE}
  422. Result := RenameFile(PChar(SourceFileName),PChar(DestFileName));
  423. {$ENDIF}
  424. end;
  425. {$IFNDEF NEXTGEN}
  426. class function TFile.IsInUse(const Path : string) : Boolean;
  427. begin
  428. Result := IsFileInUse(Path);
  429. end;
  430. {$ENDIF}
  431. class function TFile.GetSize(const Path : string) : Int64;
  432. var
  433. f : File of Byte;
  434. begin
  435. Assign(f,Path);
  436. try
  437. Reset (f);
  438. Result := FileSize(f);
  439. finally
  440. CloseFile(f);
  441. end;
  442. end;
  443. class function TFile.GetExtension(const Path : string) : string;
  444. begin
  445. Result := ExtractFileExt(Path);
  446. end;
  447. class function TFile.GetCreationTime(const Path : string) : TDateTime;
  448. begin
  449. Result := Quick.Files.GetCreationTime(Path);
  450. end;
  451. class function TFile.GetLastAccessTime(const Path : string) : TDateTime;
  452. begin
  453. Result := Quick.Files.GetLastAccessTime(Path);
  454. end;
  455. class function TFile.GetLastWriteTime(const Path : string) : TDateTime;
  456. begin
  457. Result := Quick.Files.GetLastWriteTime(Path);
  458. end;
  459. class function TFile.Create(const Path: string; const BufferSize: Integer): TFileStream;
  460. begin
  461. try
  462. Result := TFileStream.Create(Path,fmCreate);
  463. except
  464. on E: EFileStreamError do
  465. raise EInOutError.Create(E.Message);
  466. end;
  467. end;
  468. class function TFile.Create(const Path: string): TFileStream;
  469. begin
  470. Result := Create(Path, 0);
  471. end;
  472. { TStreamWriter }
  473. procedure TStreamWriter.Close;
  474. begin
  475. Flush;
  476. if FOwnsStream then
  477. FreeAndNil(FStream);
  478. end;
  479. constructor TStreamWriter.Create(Stream: TStream);
  480. begin
  481. inherited Create;
  482. FOwnsStream := False;
  483. FStream := Stream;
  484. FEncoding := TEncoding.UTF8;
  485. SetLength(FBuffer, 1024);
  486. FBufferIndex := 0;
  487. FNewLine := sLineBreak;
  488. FAutoFlush := True;
  489. end;
  490. constructor TStreamWriter.Create(Stream: TStream; Encoding: TEncoding; BufferSize: Integer);
  491. begin
  492. inherited Create;
  493. FOwnsStream := False;
  494. FStream := Stream;
  495. FEncoding := Encoding;
  496. if BufferSize >= 128 then
  497. SetLength(FBuffer, BufferSize)
  498. else
  499. SetLength(FBuffer, 128);
  500. FBufferIndex := 0;
  501. FNewLine := sLineBreak;
  502. FAutoFlush := True;
  503. if Stream.Position = 0 then
  504. WriteBytes(FEncoding.GetPreamble);
  505. end;
  506. constructor TStreamWriter.Create(const Filename: string; Append: Boolean);
  507. begin
  508. if (not FileExists(Filename)) or (not Append) then
  509. FStream := TFileStream.Create(Filename, fmCreate)
  510. else
  511. begin
  512. FStream := TFileStream.Create(Filename, fmOpenWrite);
  513. FStream.Seek(0, soEnd);
  514. end;
  515. Create(FStream);
  516. FOwnsStream := True;
  517. end;
  518. constructor TStreamWriter.Create(const Filename: string; Append: Boolean;
  519. Encoding: TEncoding; BufferSize: Integer);
  520. begin
  521. if (not FileExists(Filename)) or (not Append) then
  522. FStream := TFileStream.Create(Filename, fmCreate)
  523. else
  524. begin
  525. FStream := TFileStream.Create(Filename, fmOpenWrite);
  526. FStream.Seek(0, soEnd);
  527. end;
  528. Create(FStream, Encoding, BufferSize);
  529. FOwnsStream := True;
  530. end;
  531. destructor TStreamWriter.Destroy;
  532. begin
  533. Close;
  534. SetLength(FBuffer, 0);
  535. inherited;
  536. end;
  537. procedure TStreamWriter.Flush;
  538. begin
  539. if FBufferIndex = 0 then
  540. Exit;
  541. if FStream = nil then
  542. Exit;
  543. FStream.Write(FBuffer[0], FBufferIndex);
  544. FBufferIndex := 0;
  545. end;
  546. procedure TStreamWriter.OwnStream;
  547. begin
  548. FOwnsStream := True;
  549. end;
  550. procedure TStreamWriter.Write(const Value: string);
  551. begin
  552. WriteBytes(FEncoding.GetBytes(Value));
  553. end;
  554. procedure TStreamWriter.WriteBytes(Bytes: TBytes);
  555. var
  556. ByteIndex: Integer;
  557. WriteLen: Integer;
  558. begin
  559. ByteIndex := 0;
  560. while ByteIndex < Length(Bytes) do
  561. begin
  562. WriteLen := Length(Bytes) - ByteIndex;
  563. if WriteLen > Length(FBuffer) - FBufferIndex then
  564. WriteLen := Length(FBuffer) - FBufferIndex;
  565. Move(Bytes[ByteIndex], FBuffer[FBufferIndex], WriteLen);
  566. Inc(FBufferIndex, WriteLen);
  567. Inc(ByteIndex, WriteLen);
  568. if FBufferIndex >= Length(FBuffer) then
  569. Flush;
  570. end;
  571. if FAutoFlush then
  572. Flush;
  573. end;
  574. procedure TStreamWriter.Write(const aFormat: string; Args: array of const);
  575. begin
  576. WriteBytes(FEncoding.GetBytes(Format(aFormat, Args)));
  577. end;
  578. procedure TStreamWriter.Write(Value: Single);
  579. begin
  580. WriteBytes(FEncoding.GetBytes(FloatToStr(Value)));
  581. end;
  582. procedure TStreamWriter.Write(Value: Double);
  583. begin
  584. WriteBytes(FEncoding.GetBytes(FloatToStr(Value)));
  585. end;
  586. procedure TStreamWriter.Write(Value: Integer);
  587. begin
  588. WriteBytes(FEncoding.GetBytes(IntToStr(Value)));
  589. end;
  590. procedure TStreamWriter.Write(Value: Char);
  591. begin
  592. WriteBytes(FEncoding.GetBytes(Value));
  593. end;
  594. procedure TStreamWriter.Write(Value: TObject);
  595. begin
  596. WriteBytes(FEncoding.GetBytes(Value.ToString));
  597. end;
  598. procedure TStreamWriter.Write(Value: Int64);
  599. begin
  600. WriteBytes(FEncoding.GetBytes(IntToStr(Value)));
  601. end;
  602. procedure TStreamWriter.Write(Value: Boolean);
  603. begin
  604. WriteBytes(FEncoding.GetBytes(BoolToStr(Value, True)));
  605. end;
  606. procedure TStreamWriter.WriteLine(Value: Double);
  607. begin
  608. WriteBytes(FEncoding.GetBytes(FloatToStr(Value) + FNewLine));
  609. end;
  610. procedure TStreamWriter.WriteLine(Value: Integer);
  611. begin
  612. WriteBytes(FEncoding.GetBytes(IntToStr(Value) + FNewLine));
  613. end;
  614. procedure TStreamWriter.WriteLine;
  615. begin
  616. WriteBytes(FEncoding.GetBytes(FNewLine));
  617. end;
  618. procedure TStreamWriter.WriteLine(Value: Boolean);
  619. begin
  620. WriteBytes(FEncoding.GetBytes(BoolToStr(Value, True) + FNewLine));
  621. end;
  622. procedure TStreamWriter.WriteLine(Value: Char);
  623. begin
  624. WriteBytes(FEncoding.GetBytes(Value));
  625. WriteBytes(FEncoding.GetBytes(FNewLine));
  626. end;
  627. procedure TStreamWriter.WriteLine(Value: Int64);
  628. begin
  629. WriteBytes(FEncoding.GetBytes(IntToStr(Value) + FNewLine));
  630. end;
  631. procedure TStreamWriter.WriteLine(const aFormat: string; Args: array of const);
  632. begin
  633. WriteBytes(FEncoding.GetBytes(Format(aFormat, Args) + FNewLine));
  634. end;
  635. procedure TStreamWriter.WriteLine(Value: TObject);
  636. begin
  637. WriteBytes(FEncoding.GetBytes(Value.ToString + FNewLine));
  638. end;
  639. procedure TStreamWriter.WriteLine(Value: Single);
  640. begin
  641. WriteBytes(FEncoding.GetBytes(FloatToStr(Value) + FNewLine));
  642. end;
  643. procedure TStreamWriter.WriteLine(const Value: string);
  644. begin
  645. WriteBytes(FEncoding.GetBytes(Value + FNewLine));
  646. end;
  647. {$ENDIF FPC}
  648. {other functions}
  649. function CreateDummyFile(const aFilename : string; const aSize : Int64 ) : Boolean;
  650. var
  651. fs : TFileStream;
  652. i : Integer;
  653. buf : string;
  654. Begin
  655. fs := TFileStream.Create(aFilename,fmCreate);
  656. buf := 'A';
  657. try
  658. fs.Seek(0, soBeginning);
  659. for i := 0 to aSize do fs.Write(buf[1], Length(buf));
  660. finally
  661. fs.Free;
  662. end;
  663. Result := FileExists(aFilename);
  664. End;
  665. procedure SplitFile(const aFileName : string; aSplitByteSize : Int64);
  666. var
  667. fs, ss: TFileStream;
  668. cnt : integer;
  669. splitname: string;
  670. begin
  671. fs := TFileStream.Create(aFileName, fmOpenRead or fmShareDenyWrite) ;
  672. try
  673. for cnt := 1 to Trunc(fs.Size / aSplitByteSize) + 1 do
  674. begin
  675. splitname := ChangeFileExt(aFileName, Format('%s%.3d', ['.',cnt])) ;
  676. ss := TFileStream.Create(splitname, fmCreate or fmShareExclusive) ;
  677. try
  678. if fs.Size - fs.Position < aSplitByteSize then
  679. aSplitByteSize := fs.Size - fs.Position;
  680. ss.CopyFrom(fs, aSplitByteSize) ;
  681. finally
  682. ss.Free;
  683. end;
  684. end;
  685. finally
  686. fs.Free;
  687. end;
  688. end;
  689. procedure MergeFiles(const aFirstSplitFileName, aOutFileName : string);
  690. var
  691. fs, ss: TFileStream;
  692. cnt: integer;
  693. splitfilename : string;
  694. begin
  695. cnt := 1;
  696. splitfilename := aFirstSplitFileName;
  697. fs := TFileStream.Create(aOutFileName, fmCreate or fmShareExclusive) ;
  698. try
  699. while FileExists(splitfilename) do
  700. begin
  701. ss := TFileStream.Create(splitfilename, fmOpenRead or fmShareDenyWrite) ;
  702. try
  703. fs.CopyFrom(ss, 0) ;
  704. finally
  705. ss.Free;
  706. end;
  707. Inc(cnt) ;
  708. splitfilename := ChangeFileExt(aFirstSplitFileName, Format('%s%.3d', ['.',cnt])) ;
  709. end;
  710. finally
  711. fs.Free;
  712. end;
  713. end;
  714. procedure MergeFiles(aFilenames : array of string; const aOutFileName : string);
  715. var
  716. filename : string;
  717. fs,
  718. ss : TFileStream;
  719. begin
  720. fs := TFileStream.Create(aOutFileName,fmCreate or fmShareExclusive) ;
  721. try
  722. for filename in aFilenames do
  723. begin
  724. if not FileExists(filename) then raise Exception.CreateFmt('Merge file %s not found!',[filename]);
  725. ss := TFileStream.Create(filename, fmOpenRead or fmShareDenyWrite) ;
  726. try
  727. fs.CopyFrom(ss,0);
  728. finally
  729. ss.Free;
  730. end;
  731. end;
  732. finally
  733. fs.Free;
  734. end;
  735. end;
  736. function IsFileInUse(const aFileName : string) : Boolean;
  737. {$IF NOT Defined(LINUX) AND NOT Defined(MACOS) AND NOT Defined(ANDROID)}
  738. var
  739. HFileRes: HFILE;
  740. begin
  741. Result := False;
  742. if not FileExists(aFileName) then Exit;
  743. try
  744. HFileRes := CreateFile(PChar(aFileName),
  745. GENERIC_READ or GENERIC_WRITE
  746. ,0
  747. ,nil
  748. ,OPEN_EXISTING
  749. ,FILE_ATTRIBUTE_NORMAL
  750. ,0);
  751. Result := (HFileRes = INVALID_HANDLE_VALUE);
  752. if not(Result) then begin
  753. CloseHandle(HFileRes);
  754. end;
  755. except
  756. Result := True;
  757. end;
  758. end;
  759. {$ELSE}
  760. var
  761. fs : TFileStream;
  762. begin
  763. try
  764. fs := TFileStream.Create(aFileName, fmOpenReadWrite, fmShareExclusive);
  765. Result := True;
  766. fs.Free;
  767. except
  768. Result := False;
  769. end;
  770. end;
  771. {$ENDIF}
  772. procedure FileReplaceText(const aFileName, aSearchText, AReplaceText : string);
  773. var
  774. fs: TFileStream;
  775. S: string;
  776. begin
  777. fs := TFileStream.Create(aFileName, fmOpenread or fmShareDenyNone);
  778. try
  779. SetLength(S, fs.Size);
  780. fs.ReadBuffer(S[1], fs.Size);
  781. finally
  782. fs.Free;
  783. end;
  784. S := StringReplace(S, aSearchText, AReplaceText, [rfReplaceAll, rfIgnoreCase]);
  785. fs := TFileStream.Create(aFileName, fmCreate);
  786. try
  787. fs.WriteBuffer(S[1], Length(S));
  788. finally
  789. fs.Free;
  790. end;
  791. end;
  792. {$IFNDEF NEXTGEN}
  793. function FileSearchText(const aFileName, SearchText: string; caseSensitive : Boolean): Longint;
  794. const
  795. BufferSize = $8001;
  796. var
  797. pBuf, pEnd, pScan, pPos: PAnsiChar;
  798. filesize: LongInt;
  799. bytesRemaining: LongInt;
  800. bytesToRead: Integer;
  801. F: file;
  802. SearchFor: PAnsiChar;
  803. oldMode: Word;
  804. begin
  805. Result := -1;
  806. if (Length(SearchText) = 0) or (Length(aFileName) = 0) then Exit;
  807. SearchFor := nil;
  808. pBuf := nil;
  809. AssignFile(F, aFileName);
  810. oldMode := FileMode;
  811. FileMode := 0;
  812. Reset(F, 1);
  813. FileMode := oldMode;
  814. try
  815. {$IFDEF FPC}
  816. SearchFor := PChar(StrAlloc(Length(SearchText) + 1));
  817. {$ELSE}
  818. {$IFDEF DELPHI2010_UP}
  819. SearchFor := PAnsiChar(StrAlloc(Length(SearchText) + 1));
  820. {$ELSE}
  821. SearchFor := StrAlloc(Length(SearchText) + 1);
  822. {$ENDIF}
  823. {$ENDIF FPC}
  824. StrPCopy(SearchFor, SearchText);
  825. {$IFDEF FPC}
  826. if not caseSensitive then UpperCase(SearchFor);
  827. {$ELSE}
  828. if not caseSensitive then AnsiUpperCase(SearchFor);
  829. {$ENDIF}
  830. GetMem(pBuf, BufferSize);
  831. filesize := System.Filesize(F);
  832. bytesRemaining := filesize;
  833. pPos := nil;
  834. while bytesRemaining > 0 do
  835. begin
  836. if bytesRemaining >= BufferSize then bytesToRead := Pred(BufferSize)
  837. else bytesToRead := bytesRemaining;
  838. BlockRead(F, pBuf^, bytesToRead, bytesToRead);
  839. pEnd := @pBuf[bytesToRead];
  840. pEnd^ := #0;
  841. pScan := pBuf;
  842. while pScan < pEnd do
  843. begin
  844. {$IFDEF FPC}
  845. if not caseSensitive then UpperCase(pScan);
  846. {$ELSE}
  847. if not caseSensitive then AnsiUpperCase(pScan);
  848. {$ENDIF}
  849. pPos := StrPos(pScan, SearchFor);
  850. if pPos <> nil then
  851. begin
  852. Result := FileSize - bytesRemaining +
  853. Longint(pPos) - Longint(pBuf);
  854. Break;
  855. end;
  856. pScan := StrEnd(pScan);
  857. Inc(pScan);
  858. end;
  859. if pPos <> nil then Break;
  860. bytesRemaining := bytesRemaining - bytesToRead;
  861. if bytesRemaining > 0 then
  862. begin
  863. Seek(F, FilePos(F) - Length(SearchText));
  864. bytesRemaining := bytesRemaining + Length(SearchText);
  865. end;
  866. end;
  867. finally
  868. CloseFile(F);
  869. if SearchFor <> nil then StrDispose(SearchFor);
  870. if pBuf <> nil then FreeMem(pBuf, BufferSize);
  871. end;
  872. end;
  873. {$ENDIF}
  874. {$IFDEF MSWINDOWS}
  875. function GetLastAccessTime(const aFileName: string): TDateTime;
  876. var
  877. ffd: TWin32FindData;
  878. dft: DWORD;
  879. lft: TFileTime;
  880. h: THandle;
  881. begin
  882. Result := 0;
  883. {$IFDEF FPC}
  884. h := FindFirstFile(PAnsiChar(aFileName), ffd);
  885. {$ELSE}
  886. h := FindFirstFile(PChar(aFileName), ffd);
  887. {$ENDIF}
  888. if (INVALID_HANDLE_VALUE <> h) then
  889. begin
  890. FindClose(h);
  891. FileTimeToLocalFileTime(ffd.ftLastAccessTime, lft);
  892. FileTimeToDosDateTime(lft, LongRec(dft).Hi, LongRec(dft).Lo);
  893. Result := FileDateToDateTime(dft);
  894. end;
  895. end;
  896. function GetCreationTime(const aFilename : string): TDateTime;
  897. var
  898. ffd: TWin32FindData;
  899. dft: DWORD;
  900. lft: TFileTime;
  901. h: THandle;
  902. begin
  903. Result := 0;
  904. {$IFDEF FPC}
  905. h := FindFirstFile(PAnsiChar(aFileName), ffd);
  906. {$ELSE}
  907. h := FindFirstFile(PChar(aFileName), ffd);
  908. {$ENDIF}
  909. if (INVALID_HANDLE_VALUE <> h) then
  910. begin
  911. FindClose(h);
  912. FileTimeToLocalFileTime(ffd.ftCreationTime, lft);
  913. FileTimeToDosDateTime(lft, LongRec(dft).Hi, LongRec(dft).Lo);
  914. Result := FileDateToDateTime(dft);
  915. end;
  916. end;
  917. function GetLastWriteTime(const aFileName : string): TDateTime;
  918. var
  919. ffd: TWin32FindData;
  920. dft: DWORD;
  921. lft: TFileTime;
  922. h: THandle;
  923. begin
  924. Result := 0;
  925. {$IFDEF FPC}
  926. h := FindFirstFile(PAnsiChar(aFileName), ffd);
  927. {$ELSE}
  928. h := FindFirstFile(PChar(aFileName), ffd);
  929. {$ENDIF}
  930. if (INVALID_HANDLE_VALUE <> h) then
  931. begin
  932. FindClose(h);
  933. FileTimeToLocalFileTime(ffd.ftLastWriteTime, lft);
  934. FileTimeToDosDateTime(lft, LongRec(dft).Hi, LongRec(dft).Lo);
  935. Result := FileDateToDateTime(dft);
  936. end;
  937. end;
  938. {$ELSE}
  939. {$IFDEF FPC} //FPC Linux
  940. function GetLastAccessTime(const aFileName: string): TDateTime;
  941. var
  942. info : stat;
  943. begin
  944. Result := 0;
  945. if fpstat(aFileName,info) <> 0 then
  946. begin
  947. Result := info.st_atime;
  948. end;
  949. end;
  950. function GetCreationTime(const aFilename : string): TDateTime;
  951. var
  952. info : stat;
  953. begin
  954. Result := 0;
  955. if fpstat(aFileName,info) <> 0 then
  956. begin
  957. Result := info.st_ctime;
  958. end;
  959. end;
  960. function GetLastWriteTime(const aFileName : string): TDateTime;
  961. var
  962. info : stat;
  963. begin
  964. Result := 0;
  965. if fpstat(aFileName,info) <> 0 then
  966. begin
  967. Result := info.st_mtime;
  968. end;
  969. end;
  970. {$ELSE} //Delphi Nextgen & Linux
  971. function GetLastAccessTime(const aFileName: string): TDateTime;
  972. var
  973. info : TDateTimeInfoRec;
  974. begin
  975. if FileGetDateTimeInfo(aFileName,info,True) then Result := info.LastAccessTime
  976. else Result := 0.0;
  977. end;
  978. function GetCreationTime(const aFilename : string): TDateTime;
  979. var
  980. info : TDateTimeInfoRec;
  981. begin
  982. if FileGetDateTimeInfo(aFileName,info,True) then Result := info.CreationTime
  983. else Result := 0.0;
  984. end;
  985. function GetLastWriteTime(const aFileName : string): TDateTime;
  986. var
  987. info : TDateTimeInfoRec;
  988. begin
  989. if FileGetDateTimeInfo(aFileName,info,True) then Result := info.TimeStamp
  990. else Result := 0.0;
  991. end;
  992. {$ENDIF}
  993. {$ENDIF}
  994. {$IFDEF FPC}
  995. function FindDelimiter(const Delimiters, S: string; StartIdx: Integer = 1): Integer;
  996. var
  997. Stop: Boolean;
  998. Len: Integer;
  999. begin
  1000. Result := 0;
  1001. Len := S.Length;
  1002. Stop := False;
  1003. while (not Stop) and (StartIdx <= Len) do
  1004. if IsDelimiter(Delimiters, S, StartIdx) then
  1005. begin
  1006. Result := StartIdx;
  1007. Stop := True;
  1008. end
  1009. else
  1010. Inc(StartIdx);
  1011. end;
  1012. {$ENDIF}
  1013. {$IFDEF MSWINDOWS}
  1014. function ConvertDateTimeToFileTime(const DateTime: TDateTime; const UseLocalTimeZone: Boolean): TFileTime;
  1015. var
  1016. LFileTime: TFileTime;
  1017. SysTime: TSystemTime;
  1018. begin
  1019. Result.dwLowDateTime := 0;
  1020. Result.dwLowDateTime := 0;
  1021. DecodeDateTime(DateTime, SysTime.wYear, SysTime.wMonth, SysTime.wDay,
  1022. SysTime.wHour, SysTime.wMinute, SysTime.wSecond, SysTime.wMilliseconds);
  1023. if SystemTimeToFileTime(SysTime, LFileTime) then
  1024. if UseLocalTimeZone then
  1025. LocalFileTimeToFileTime(LFileTime, Result)
  1026. else
  1027. Result := LFileTime;
  1028. end;
  1029. function ConvertFileTimeToDateTime(const FileTime : TFileTime; const UseLocalTimeZone : Boolean) : TDateTime;
  1030. var
  1031. dft: DWORD;
  1032. lft: TFileTime;
  1033. begin
  1034. FileTimeToLocalFileTime(FileTime, lft);
  1035. FileTimeToDosDateTime(lft, LongRec(dft).Hi, LongRec(dft).Lo);
  1036. Result := FileDateToDateTime(dft);
  1037. end;
  1038. {$ENDIF}
  1039. {$If Defined(FPC) AND Defined(LINUX)}
  1040. function ConvertDateTimeToFileTime(const DateTime: TDateTime; const UseLocalTimeZone: Boolean): TFileTime;
  1041. begin
  1042. { Use the time zone if necessary }
  1043. if not UseLocalTimeZone then
  1044. Result := DateTimeToFileDate(DateTime)
  1045. else
  1046. Result := DateTimeToFileDate(DateTime);
  1047. end;
  1048. {$ENDIF}
  1049. {$IFDEF POSIX}
  1050. function ConvertDateTimeToFileTime(const DateTime: TDateTime; const UseLocalTimeZone: Boolean): TFileTime;
  1051. begin
  1052. { Use the time zone if necessary }
  1053. if not UseLocalTimeZone then
  1054. Result := DateTimeToFileDate(TTimeZone.Local.ToLocalTime(DateTime))
  1055. else
  1056. Result := DateTimeToFileDate(DateTime);
  1057. end;
  1058. {$ENDIF}
  1059. procedure SetDateTimeInfo(const Path: string; const CreationTime, LastAccessTime, LastWriteTime: PDateTime; const UseLocalTimeZone: Boolean);
  1060. {$IFDEF MSWINDOWS}
  1061. var
  1062. LFileHnd: THandle;
  1063. LFileAttr: Cardinal;
  1064. LFileCreationTime: PFileTime;
  1065. LFileLastAccessTime: PFileTime;
  1066. LFileLastWriteTime: PFileTime;
  1067. begin
  1068. // establish what date-times must be set to the directory
  1069. LFileHnd := 0;
  1070. LFileCreationTime := nil;
  1071. LFileLastAccessTime := nil;
  1072. LFileLastWriteTime := nil;
  1073. try
  1074. try
  1075. if Assigned(CreationTime) then
  1076. begin
  1077. New(LFileCreationTime);
  1078. LFileCreationTime^ := ConvertDateTimeToFileTime(CreationTime^, UseLocalTimeZone);
  1079. end;
  1080. if Assigned(LastAccessTime) then
  1081. begin
  1082. New(LFileLastAccessTime);
  1083. LFileLastAccessTime^ := ConvertDateTimeToFileTime(LastAccessTime^, UseLocalTimeZone);
  1084. end;
  1085. if Assigned(LastWriteTime) then
  1086. begin
  1087. New(LFileLastWriteTime);
  1088. LFileLastWriteTime^ := ConvertDateTimeToFileTime(LastWriteTime^, UseLocalTimeZone);
  1089. end;
  1090. // determine if Path points to a directory or a file
  1091. SetLastError(ERROR_SUCCESS);
  1092. LFileAttr := FileGetAttr(Path);
  1093. if LFileAttr and faDirectory <> 0 then
  1094. LFileAttr := FILE_FLAG_BACKUP_SEMANTICS
  1095. else
  1096. LFileAttr := FILE_ATTRIBUTE_NORMAL;
  1097. // set the new date-times to the directory or file
  1098. LFileHnd := CreateFile(PChar(Path), GENERIC_WRITE, FILE_SHARE_WRITE, nil,
  1099. OPEN_EXISTING, LFileAttr, 0);
  1100. if LFileHnd <> INVALID_HANDLE_VALUE then
  1101. SetFileTime(LFileHnd, LFileCreationTime, LFileLastAccessTime, LFileLastWriteTime);
  1102. except
  1103. on E: EConvertError do
  1104. raise EArgumentOutOfRangeException.Create(E.Message);
  1105. end;
  1106. finally
  1107. CloseHandle(LFileHnd);
  1108. SetLastError(ERROR_SUCCESS);
  1109. Dispose(LFileCreationTime);
  1110. Dispose(LFileLastAccessTime);
  1111. Dispose(LFileLastWriteTime);
  1112. end;
  1113. end;
  1114. {$ENDIF}
  1115. {$IFDEF POSIX}
  1116. var
  1117. LFileName: Pointer;
  1118. LStatBuf: _stat;
  1119. LBuf: utimbuf;
  1120. ErrCode: Integer;
  1121. M: TMarshaller;
  1122. begin
  1123. { Do nothing if no date/time passed. Ignore CreationTime. Unixes do not support creation times for files. }
  1124. if (LastAccessTime = nil) and (LastWriteTime = nil) then
  1125. Exit;
  1126. LFileName := M.AsAnsi(Path, CP_UTF8).ToPointer;
  1127. { Obtain the file times. lstat may fail }
  1128. if ((LastAccessTime = nil) or (LastWriteTime = nil)) then
  1129. begin
  1130. ErrCode := stat(LFileName, LStatBuf);
  1131. { Fail if we can't access the file properly }
  1132. if ErrCode <> 0 then
  1133. Exit; // Fail here prematurely. Do not chnage file times if we failed to fetch the old ones.
  1134. end;
  1135. try
  1136. { Preserve of set the new value }
  1137. if LastAccessTime <> nil then
  1138. LBuf.actime := ConvertDateTimeToFileTime(LastAccessTime^, UseLocalTimeZone)
  1139. else
  1140. LBuf.actime := LStatBuf.st_atime;
  1141. { Preserve of set the new value }
  1142. if LastWriteTime <> nil then
  1143. LBuf.modtime := ConvertDateTimeToFileTime(LastWriteTime^, UseLocalTimeZone)
  1144. else
  1145. LBuf.modtime := LStatBuf.st_mtime;
  1146. { Call utime to set the file times }
  1147. utime(LFileName, LBuf);
  1148. except
  1149. on E: EConvertError do // May rise in ConvertDateTimeToFileTime
  1150. raise EArgumentOutOfRangeException.Create(E.Message);
  1151. end;
  1152. end;
  1153. {$ENDIF}
  1154. {$if Defined(FPC) AND Defined(LINUX)}
  1155. begin
  1156. end;
  1157. {$ENDIF}
  1158. function GetFiles(const Path : string; Recursive : Boolean) : TArray<TDirItem>;
  1159. var
  1160. rec : TSearchRec;
  1161. diritem : TDirItem;
  1162. begin
  1163. if FindFirst(IncludeTrailingPathDelimiter(Path) + '*', faAnyFile, rec) = 0 then
  1164. try
  1165. repeat
  1166. if (rec.Attr and faDirectory) <> faDirectory then
  1167. begin
  1168. diritem.Name := rec.Name;
  1169. diritem.IsDirectory := False;
  1170. diritem.Size := rec.Size;
  1171. {$IFNDEF LINUX}
  1172. diritem.CreationDate := ConvertFileTimeToDateTime(rec.FindData.ftCreationTime,True);
  1173. diritem.LastModified := ConvertFileTimeToDateTime(rec.FindData.ftLastWriteTime,True);
  1174. {$ELSE}
  1175. diritem.CreationDate := FileDateToDateTime(rec.Time);
  1176. {$ENDIF}
  1177. Result := Result + [diritem];
  1178. end
  1179. else
  1180. begin
  1181. if Recursive then Result := Result + GetFiles(IncludeTrailingPathDelimiter(Path) + diritem.Name,Recursive);
  1182. end;
  1183. until FindNext(rec) <> 0;
  1184. finally
  1185. SysUtils.FindClose(rec);
  1186. end;
  1187. end;
  1188. procedure GetFiles(const Path : string; aAddToList : TDirItemAddProc; Recursive : Boolean);
  1189. var
  1190. rec : TSearchRec;
  1191. diritem : TDirItem;
  1192. begin
  1193. if FindFirst(IncludeTrailingPathDelimiter(Path) + '*', faAnyFile, rec) = 0 then
  1194. try
  1195. repeat
  1196. if (rec.Attr and faDirectory) <> faDirectory then
  1197. begin
  1198. diritem.Name := rec.Name;
  1199. diritem.IsDirectory := False;
  1200. diritem.Size := rec.Size;
  1201. {$IFNDEF LINUX}
  1202. diritem.CreationDate := ConvertFileTimeToDateTime(rec.FindData.ftCreationTime,True);
  1203. diritem.LastModified := ConvertFileTimeToDateTime(rec.FindData.ftLastWriteTime,True);
  1204. {$ELSE}
  1205. diritem.CreationDate := FileDateToDateTime(rec.Time);
  1206. {$ENDIF}
  1207. aAddToList(diritem);
  1208. end
  1209. else
  1210. begin
  1211. if Recursive then GetFiles(IncludeTrailingPathDelimiter(Path) + diritem.Name,aAddToList,Recursive);
  1212. end;
  1213. until FindNext(rec) <> 0;
  1214. finally
  1215. SysUtils.FindClose(rec);
  1216. end;
  1217. end;
  1218. function GetDirectories(const Path : string; Recursive : Boolean) : TArray<TDirItem>;
  1219. var
  1220. rec : TSearchRec;
  1221. diritem : TDirItem;
  1222. begin
  1223. if FindFirst(IncludeTrailingPathDelimiter(Path) + '*', faAnyFile, rec) = 0 then
  1224. try
  1225. repeat
  1226. if ((rec.Attr and faDirectory) = faDirectory) and (rec.Name <> '.') and (rec.Name <> '..') then
  1227. begin
  1228. diritem.Name := rec.Name;
  1229. diritem.IsDirectory := True;
  1230. diritem.Size := rec.Size;
  1231. {$IFNDEF LINUX}
  1232. diritem.CreationDate := ConvertFileTimeToDateTime(rec.FindData.ftCreationTime,True);
  1233. diritem.LastModified := ConvertFileTimeToDateTime(rec.FindData.ftLastWriteTime,True);
  1234. {$ELSE}
  1235. diritem.CreationDate := FileDateToDateTime(rec.Time);
  1236. {$ENDIF}
  1237. Result := Result + [diritem];
  1238. if Recursive then Result := Result + GetFiles(IncludeTrailingPathDelimiter(Path) + diritem.Name,Recursive);
  1239. end;
  1240. until FindNext(rec) <> 0;
  1241. finally
  1242. SysUtils.FindClose(rec);
  1243. end;
  1244. end;
  1245. function GetFilesAndDirectories(const Path : string; Recursive : Boolean) : TArray<TDirItem>;
  1246. var
  1247. rec : TSearchRec;
  1248. diritem : TDirItem;
  1249. dirpath : string;
  1250. wildcard : string;
  1251. begin
  1252. if Path.Contains('*') then
  1253. begin
  1254. dirpath := ExtractFilePath(Path);
  1255. wildcard := ExtractFileName(Path);
  1256. end
  1257. else
  1258. begin
  1259. dirpath := Path;
  1260. wildcard := '*';
  1261. end;
  1262. dirpath := IncludeTrailingPathDelimiter(dirpath);
  1263. if FindFirst(dirpath + wildcard, faAnyFile, rec) = 0 then
  1264. try
  1265. repeat
  1266. if (rec.Attr and faDirectory) <> faDirectory then
  1267. begin
  1268. diritem.Name := rec.Name;
  1269. diritem.IsDirectory := False;
  1270. diritem.Size := rec.Size;
  1271. {$IFNDEF LINUX}
  1272. diritem.CreationDate := ConvertFileTimeToDateTime(rec.FindData.ftCreationTime,True);
  1273. diritem.LastModified := ConvertFileTimeToDateTime(rec.FindData.ftLastWriteTime,True);
  1274. {$ELSE}
  1275. diritem.CreationDate := FileDateToDateTime(rec.Time);
  1276. {$ENDIF}
  1277. Result := Result + [diritem];
  1278. end
  1279. else if (rec.Name <> '.') and (rec.Name <> '..') then
  1280. begin
  1281. diritem.Name := rec.Name;
  1282. diritem.IsDirectory := True;
  1283. diritem.Size := rec.Size;
  1284. {$IFNDEF LINUX}
  1285. diritem.CreationDate := ConvertFileTimeToDateTime(rec.FindData.ftCreationTime,True);
  1286. diritem.LastModified := ConvertFileTimeToDateTime(rec.FindData.ftLastWriteTime,True);
  1287. {$ELSE}
  1288. diritem.CreationDate := FileDateToDateTime(rec.Time);
  1289. {$ENDIF}
  1290. Result := Result + [diritem];
  1291. if Recursive then Result := Result + GetFilesAndDirectories(dirpath + diritem.Name,Recursive);
  1292. end;
  1293. until FindNext(rec) <> 0;
  1294. finally
  1295. SysUtils.FindClose(rec);
  1296. end;
  1297. end;
  1298. procedure GetFilesAndDirectories(const Path : string; aAddToList : TDirItemAddProc; Recursive : Boolean);
  1299. var
  1300. rec : TSearchRec;
  1301. diritem : TDirItem;
  1302. dirpath : string;
  1303. wildcard : string;
  1304. begin
  1305. if not Assigned(aAddToList) then raise Exception.Create('GetFilesAndDirecties: AddToList cannot be nil!');
  1306. if Path.Contains('*') then
  1307. begin
  1308. dirpath := ExtractFilePath(Path);
  1309. wildcard := ExtractFileName(Path);
  1310. end
  1311. else
  1312. begin
  1313. dirpath := Path;
  1314. wildcard := '*';
  1315. end;
  1316. dirpath := IncludeTrailingPathDelimiter(dirpath);
  1317. if FindFirst(dirpath + wildcard, faAnyFile, rec) = 0 then
  1318. try
  1319. repeat
  1320. if (rec.Attr and faDirectory) <> faDirectory then
  1321. begin
  1322. diritem.Name := rec.Name;
  1323. diritem.IsDirectory := False;
  1324. diritem.Size := rec.Size;
  1325. {$IFNDEF LINUX}
  1326. diritem.CreationDate := ConvertFileTimeToDateTime(rec.FindData.ftCreationTime,True);
  1327. diritem.LastModified := ConvertFileTimeToDateTime(rec.FindData.ftLastWriteTime,True);
  1328. {$ELSE}
  1329. diritem.CreationDate := FileDateToDateTime(rec.Time);
  1330. {$ENDIF}
  1331. aAddToList(diritem);
  1332. end
  1333. else if (rec.Name <> '.') and (rec.Name <> '..') then
  1334. begin
  1335. diritem.Name := rec.Name;
  1336. diritem.IsDirectory := True;
  1337. diritem.Size := rec.Size;
  1338. {$IFNDEF LINUX}
  1339. diritem.CreationDate := ConvertFileTimeToDateTime(rec.FindData.ftCreationTime,True);
  1340. diritem.LastModified := ConvertFileTimeToDateTime(rec.FindData.ftLastWriteTime,True);
  1341. {$ELSE}
  1342. diritem.CreationDate := FileDateToDateTime(rec.Time);
  1343. {$ENDIF}
  1344. aAddToList(diritem);
  1345. if Recursive then GetFilesAndDirectories(dirpath + diritem.Name,aAddToList,Recursive);
  1346. end;
  1347. until FindNext(rec) <> 0;
  1348. finally
  1349. SysUtils.FindClose(rec);
  1350. end;
  1351. end;
  1352. end.