在現有文本檔案中寫入多個條目后創建一個新的文本檔案-有解無憂

我正在嘗試在現有 .txt 檔案中輸入一定數量的條目后創建一個新的 .txt 檔案。例如，我想在我的檔案中有 50 個條目，然后，我想創建一個新檔案，并且這些條目繼續在該新檔案中。假設我不希望我的日志檔案充滿很多行，而是希望有更多的 .txt 檔案來劃分條目??。

這是我的示例代碼：

procedure TForm1.Button3Click(Sender: TObject);

  function CountRows(Afilename: string): integer;
  var
    f: TextFile;
    i: integer;
  begin
    assignfile(f, afilename);
    reset(f);
    result := 0;
    while not eof(f) do
    begin
      readln(f);
      inc(result);
    end;
    closefile(f);
  end;

var
  f: TextFile;
  fileName: String;
  fs: Tformatsettings;
begin
  fs.shortdateformat := 'DD.MM.YYYY';
  fs.TimeSeparator := ':';
  filename := 'D:\LogLprf\LogLpFr '   Datetostr(now, fs)   '.txt';
  assignfile(f, filename);
  if FileExists(filename) then
  begin
    if CountRows(filename)>=2 then
    begin
      filename := 'D:\LogLprf\LogLpFr '   Datetostr(now, fs)  '1.txt';
      assignfile(f, filename);
      rewrite(f);
    end
    else
      append(f);
  end
  else
  begin
    rewrite(f);
  end;

  fs.ShortDateFormat := 'DD.MM.YYYY HH:mm:ss';
  Writeln(f, datetimetostr(now, fs) '- ' 'Some error...');
  closefile(f);
end;

使用上面的代碼，我設法創建了第一個檔案，并在第一個檔案中達到條目限制時創建了第二個檔案。但是，第二個檔案每次都會重新創建。我知道那是因為我正在打電話rewrite(f)，但我需要在前一個檔案的條目結束后創建一個新的 .txt 檔案。我也試過呼叫fileexists(filename)afterCountRows(filename)但這不是一個好的解決方案，因為我會有很多嵌套的 if 陳述句，如果我們需要創建很多 .txt 檔案，這將無法解決問題。我也嘗試過回圈，但這也沒有解決問題。歡迎提出任何建議...謝謝

uj5u.com熱心網友回復：

當您定義檔案名時，您使用的是DateToStr，它只會將日期資訊添加到您的檔案名中。因此，如果您嘗試在一天內多次創建新檔案名，您將始終獲得相同的檔案名，因為DateToString每次都會回傳相同的結果。

DateToString您應該使用DateTimeToString而不是使用，因為這還將在結果中包含時間資訊，從而允許您在同一天創建多個不同的檔案名。除非您需要在一秒鐘內創建多個新檔案名，否則您不會有任何問題。

另一種方法是對檔案進行遞增編號，以便每個檔案名末尾包含一個唯一編號。

您可以在此處找到有關如何實作此目標的解決方案

或者，如果您需要更加用戶友好的檔案命名系統，您也可以將您的方法與自動增量編號方法結合起來。

uj5u.com熱心網友回復：

請查看我找到的代碼作為適合我的解決方案......在所有人的幫助下評論和發布我的問題：

procedure TForm1.Button5Click(Sender: TObject);    
function SearchFiles(SearchDir, SearchFile:string):String;
var
  SearchRec: TSearchRec;
begin
  if FindFirst(SearchDir SearchFile, faAnyfile, SearchRec)=0 then
    begin
      repeat
        result := SearchRec.Name
      until (findnext(SearchRec)<>0);
    end;
    FindClose(SearchRec);
end;
function GetFilesCount(SearchDir, SearchFile : String) : Integer;
var
  SearchRec: TSearchRec;
begin
  Result := 0;

  if FindFirst(SearchDir   SearchFile, faAnyFile xor faDirectory, SearchRec)= 0 then
  begin
    repeat
      Inc(Result);
    until (FindNext(SearchRec) <> 0);
    FindClose(SearchRec);
  end;
end;
var
  FileCont: TStringList;
  f:textfile;
  FileName, S: String;
  fs: Tformatsettings;
  SearchRec: TSearchRec;
  i:integer;
begin
  FileCont := TStringList.Create;
  try
    fs.shortdateformat := 'DD.MM.YYYY';
    fs.TimeSeparator := ':';
    if SearchFiles(Extractfilepath(application.ExeName),'LogLpFr ' datetostr(now,fs) ' .txt') = '' then
      begin
        Filename := Extractfilepath(application.ExeName)   'LogLpFr '  Datetostr(Now, fs)  ' .txt';
        filecont.SaveToFile(filename);
      end
    else
      Filename := Extractfilepath(application.ExeName)   SearchFiles(Extractfilepath(application.ExeName),'LogLpFr ' datetostr(now,fs) ' *.txt');

    FileCont.LoadFromFile(FileName);
    if FileCont.Count >=2 then
      begin
       i := GetFilesCount(Extractfilepath(application.ExeName),'LogLpFr ' datetostr(now,fs) ' *.txt');
       Filename := Extractfilepath(application.ExeName)   'LogLpFr ' Datetostr(Now, fs)  ' ' i.ToString '.txt';
       FileCont.Clear();
      end;


    fs.ShortDateFormat := 'DD.MM.YYYY HH:mm:ss';
    S := DateTimeToStr(Now(), fs)   '- '   'Some error...';
    FileCont.Add(S);
    FileCont.SaveToFile(Filename);
  finally
    FileCont.Free();
  end;
end;

我使用了GetFilesCount@Ehab 提供的一個函式并添加了一個類似的函式SearchFiles，該函式將搜索所有檔案并確保最后一個檔案是我們用于寫入的檔案。（我最初的問題是，在我的第一個代碼中，我總是使用同一個檔案......）感謝所有幫助......

uj5u.com熱心網友回復：

今天我有一個破壞性的 Delphi7 所以，這里是一個完整的作業示例。

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Btn1: TButton;
    Memo1: TMemo;
    procedure Btn1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  //Just a sample class not a production one
  //Each day has log files Like  21.12.2022_0001.txt, 21.12.2022_0002.txt, ...
  TSampleLoger = class
  private
    procedure SetWorkPath(const Value: string);
    procedure SetMaxLinesPerFile(const Value: Integer);
  protected
    FileCont: TStringList;
    Fs: TFormatsettings;
    FWorkPath : string;
    FLastFile : string;
    FFilesCount : Integer;
    FMaxLinesPerFile: Integer;

    //Make a full file name without extension eg.
    //(D:\LogLprf\21.12.2022)
    function MakeBaseFileName() : string;

    //Updates FLastFile & FFilesCount and returns New file name
    function MakeNewFileName() : string;

    //Make a full file name without extension eg.
    //(D:\LogLprf\21.12.2022_0099.txt)
    function MakeFileName(C : Integer) : string;

    //Returns Today last used log file if exists
    function GetLastFileName(): string;

    //Returns Files count for a specific date and last file used for that day
    //SearchFile Param. Value will be like [D:\LogLprf\21.12.2022_*.txt]
    function GetFilesCount(SearchFile : String; var LastFileName:String) : Integer;
  public
    constructor Create(APath:string); reintroduce;
    destructor Destroy; override;

    procedure WriteToLog(Msg:String);


    property LastFile : string read GetLastFileName;
    property WorkPath : string read FWorkPath write SetWorkPath;
    property MaxLinesPerFile : Integer read FMaxLinesPerFile write SetMaxLinesPerFile;
  end;

var
  Form1: TForm1;

實施部分

implementation

{$R *.dfm}

function TSampleLoger.GetFilesCount(SearchFile : String; var LastFileName:String) : Integer;
var
  SearchRec: TSearchRec;
begin
  //Initial values
  Result := 0;
  LastFileName := '';

  if FindFirst(SearchFile, faAnyFile xor faDirectory, SearchRec)= 0 then
  begin
    repeat
      Inc(Result);
      LastFileName := SearchRec.Name;
    until (FindNext(SearchRec) <> 0);
    Windows.FindClose(SearchRec.FindHandle);
  end;
end;

constructor TSampleLoger.Create(APath: string);
begin
  inherited Create();
  WorkPath := APath;
  FileCont := TStringList.Create;

  FFilesCount := 0;
  FMaxLinesPerFile := 50;
end;

function TSampleLoger.GetLastFileName: string;
var
  S : string;
begin
  if FLastFile = '' then
  begin
    S := MakeBaseFileName()   '_*.txt';
    FFilesCount := GetFilesCount(s, FLastFile);
    FLastFile := FWorkPath   FLastFile;
  end;

  Result := FLastFile;
end;

function TSampleLoger.MakeBaseFileName() : string;
var
  Path : string;
begin
  Fs.ShortDateformat := 'DD.MM.YYYY';
  Result := FWorkPath   Datetostr(Date(), Fs);
end;

function TSampleLoger.MakeNewFileName() : string;
begin
  Inc(FFilesCount);
  FLastFile := MakeFileName(FFilesCount);
  Result := FLastFile;
end;

procedure TSampleLoger.WriteToLog(Msg:String);
var
  FileName, S: String;
begin
  FileName := GetLastFileName();

  //Do we have a file for today?
  if FileName <> '' then
  begin
    //Load file contents
    FileCont.LoadFromFile(FileName);

    //Get ready to start new file if we reached the Maximum line count per file
    if FileCont.Count >=  FMaxLinesPerFile then
      FileName := '';
  end;

  //Start new file if we don't have one
  if FileName = '' then
  begin
    FileName := MakeNewFileName();
    FileCont.Clear();
  end;

  Fs.TimeSeparator := ':';
  Fs.ShortDateFormat := 'DD.MM.YYYY HH:mm:ss';
  S := DateTimeToStr(Now(), Fs)   '- '   Msg;
  FileCont.Add(S);
  FileCont.SaveToFile(Filename);
end;

procedure TSampleLoger.SetWorkPath(const Value: string);
begin
  FWorkPath := Value;
  if FWorkPath[Length(FWorkPath)] <> '\' then
    FWorkPath := FWorkPath   '\';
end;

function TSampleLoger.MakeFileName(C: Integer): string;
const
  Fmt = '_%4.4U.txt';
begin
  //add counter and extension to file name
  Result := MakeBaseFileName()   Format(Fmt,[C]);
end;

destructor TSampleLoger.Destroy;
begin
  FileCont.Free();
  inherited;
end;

procedure TSampleLoger.SetMaxLinesPerFile(const Value: Integer);
begin
  FMaxLinesPerFile := Value;

  //At least one line per file
  if FMaxLinesPerFile < 1 then
    FMaxLinesPerFile := 1;
end;


procedure TForm1.Btn1Click(Sender: TObject);
var
  Logger : TSampleLoger;
  i : Integer;
  S : string;
begin
  Logger := TSampleLoger.Create('D:\LogLprf\');   
  try
    for i := 1 to 320 do
    begin
      //Write a randome Msg to log
      S := 'Error '   IntToStr(GetTickCount());
      Logger.WriteToLog(S);

      Memo1.Lines.Add(Logger.LastFile   ' === '   S);
      Application.ProcessMessages();
    end;
  finally
    Logger.Free();
  end;
end;

end.

uj5u.com熱心網友回復：

我現在沒有運行環境來測驗你的代碼，但我認為你可以嘗試這樣的事情：

function GetFilesCount(SearchDir, SearchFile : String) : Integer;
var
  SearchRec: TSearchRec;
begin
  Result := 0;

  if FindFirst(SearchDir   SearchFile, faAnyFile xor faDirectory, SearchRec)= 0 then
  begin
    repeat
      Inc(Result);
    until (FindNext(SearchRec) <> 0);
    Windows.FindClose(SearchRec.FindHandle);
  end;
end;

    procedure TForm1.Btn3Click(Sender: TObject);
    var
      FileCont: TStringList;
      FileName, S: String;
      fs: Tformatsettings;
      C : Integer;
    begin
      FileCont := TStringList.Create;
      try
        fs.shortdateformat := 'DD.MM.YYYY';
        fs.TimeSeparator := ':';
        FileName := 'D:\LogLprf\LogLpFr '   Datetostr(Now(), fs)   '.txt';
    
        if FileExists(FileName) then
        begin
          FileCont.LoadFromFile(FileName);
          if FileCont.Count >=2 then
          begin
            //Count previous log files.
            C := GetFilesCount('D:\LogLprf\', 'LogLpFr*.txt');
            Inc(C);
            Filename := 'D:\LogLprf\LogLpFr '   Datetostr(Now(), fs)      IntToStr(C)   '.txt';
            FileCont.Clear();
          end;
        end;
    
        fs.ShortDateFormat := 'DD.MM.YYYY HH:mm:ss';
        S := DateTimeToStr(Now(), fs)   '- '   'Some error...';
        FileCont.Add(S);
        FileCont.SaveToFile(Filename);
      finally
        FileCont.Free();
      end;
    end;

轉載請註明出處，本文鏈接：https://www.uj5u.com/yidong/536574.html

標籤：德尔福

上一篇：Zip檔案的記憶體壓縮

下一篇：顯示類貨幣Haskell