Quick.Files.pas 41 KB

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