連続した数字でシリアライズしたファイル名を作成・取得する。

 データファイルやログファイル等、連続したファイル名を作成して保存したい場合があると思います。処理したいは難しいものではないのですが、いちいちコーディングするのも面倒です。そこで、とても簡単なものですがコンポーネントにしてみました。

{
  連続ファイル名を作成する
  あまりにも簡単な処理だが、いちいちコードを書くのも面倒なので
  コンポーネントにしてみた。

  プロパティ
    Directory:   string  ファイルを作成するディレクトリ
    BaseName:    string  ファイルのベース名(ファイル名の先頭になる)
    BaseExt:     string  ファイルの拡張子名
  メソッド
    GetFileName: string  セットしたプロパティから既存のファイルをチェックして
                         連続したファイル名を返す
                         ファイル名は Directory\BaseName0001[-9999].BaseExt
                         の形式になる
                         (例: C:\Temp\Data0001.dat, C:\Temp\Data0002.dat)
                         もしファイル数が9999個を越えると、連続Noの代りに
                         FULLを返す(例: C:\Temp\DataFULL.dat)
  1999/5/4 間違いを修正
  1999/5/2
}
unit SerialFileName;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  FileCtrl;

type
  TSerialFileName = class(TComponent)
  private
    { Private 宣言 }
    FDirectory,
    FBaseName,
    FBaseExt: string;
    function GetDefDir: string;
  protected
    { Protected 宣言 }
  public
    { Public 宣言 }
    function GetFileName: string;
  published
    { Published 宣言 }
    property Directory: string read FDirectory write FDirectory;
    property BaseName: string read FBaseName write FBaseName;
    property BaseExt:    string read FBaseExt write FBaseExt;
  end;

procedure Register;

implementation

// 基準ディレクトリをチェックする
// 指定ディレクトリが存在する場合は末尾の'\'を処理して返す
// 存在しない場合は''を返す
function TSerialFileName.GetDefDir: string;
var
  dir: string;
begin
  if DirectoryExists(FDirectory) then
  begin
    if AnsiLastChar(FDirectory) <> '\' then
      dir := FDirectory + '\'
    else
      dir := FDirectory;
  end else
    dir := '';
  Result := dir;
end;

// 基準ファイル名と拡張子から連続ファイル名を作成する
function TSerialFileName.GetFileName: string;
var
  path, ext, fname, tname: string;
  i: integer;
begin
  path := GetDefDir + FBaseName;
  ext := FBaseExt;
  // 拡張子の処理(区切り子がない場合は付け加える
  if Length(ext) > 0 then
    if ext[1] <> '.' then
      Insert('.', ext, 1);
  // よもや9999もファイルをつくることはないと思うが、越えた場合に返す
  // ファイル名をあらかじめ準備しておく(9999を越えると代りにFULLを返す)
  fname := path + 'FULL' + ext;
  for i := 1 to 9999 do
  begin
    // Format関数は'%04d'では0で埋めてくれない。0で埋める場合は'%.04d'
    // と%の次に'.'をつける
    tname := path + Format('%.04d', [i]) + ext;
    if not FileExists(tname) then
    begin
      fname := tname;
      Break;
    end;
  end;
  Result := fname;
end;

procedure Register;
begin
  RegisterComponents('User', [TSerialFileName]);
end;

end.