delphi 在现有文本文件中写入多个条目后创建新的文本文件

mhd8tkvw  于 2022-11-04  发布在  其他
关注(0)|答案(4)|浏览(210)

我尝试在现有的.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文件。我也尝试过在CountRows(filename)之后调用fileexists(filename),但这不是一个好的解决方案,因为我将有很多嵌套的if语句,如果我们需要创建很多.txt文件,这将无法解决问题。我也尝试过循环,但这也不能解决问题。欢迎提出任何建议...谢谢

c86crjj0

c86crjj01#

当你定义文件名时,你使用的是DateToStr,它只会在你的文件名中添加日期信息。因此,如果你试图在一天内多次创建新文件名,你将总是得到相同的文件名,因为DateToString每次都会返回相同的结果。
如果不使用DateToString,你应该使用DateTimeToString,因为这样会在结果中包含时间信息,这样你就可以在同一天创建多个不同的文件名,除非你需要在一秒钟内创建多个新文件名,否则你不会有任何问题。
另一种方法是对文件进行递增编号,以便每个文件名的末尾都包含一个唯一的编号。
您可以找到有关如何实现此here的解决方案
或者,如果您需要更友好的文件命名系统,您也可以将您的命名系统与自动递增编号方法相结合。

wixjitnu

wixjitnu2#

请看代码,我发现作为一个解决方案,适合我很好...与所有的人的帮助下,评论和张贴到我的问题:

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;

我使用了@Ehab提供的函数GetFilesCount,并添加了一个类似的函数SearchFiles,它将搜索所有文件,并确保最后一个文件是我们正在用于编写的文件。(我最初的问题是,在我的第一个代码中,我总是使用同一个文件...)我感谢所有帮助...

5gfr0r5j

5gfr0r5j3#

今天,我有一个破坏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.
vybvopom

vybvopom4#

我现在没有运行环境来测试您的代码,但我认为您可以尝试类似的方法:

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;

相关问题