Quick.Files.pas 31 KB

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