Quick.Files.pas 32 KB

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