Quick.Files.pas 33 KB

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