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

我正在嘗試在現有 .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/qianduan/525727.html

標籤：德尔福

上一篇：應用程式沒有收到意圖廣播

下一篇：如何通過FTP填充Treeview