連続した数字でシリアライズしたファイル名を作成・取得する。
データファイルやログファイル等、連続したファイル名を作成して保存したい場合があると思います。処理したいは難しいものではないのですが、いちいちコーディングするのも面倒です。そこで、とても簡単なものですがコンポーネントにしてみました。
{
連続ファイル名を作成する
あまりにも簡単な処理だが、いちいちコードを書くのも面倒なので
コンポーネントにしてみた。
プロパティ
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.