расширения файла

← →
Alexey © (2004-04-22 09:41) [0]

Добрый день ...
Допустим программа сохраняет все данные в файл *******.*** где последний символ расширения цифра как эту цифру увеличивать на 1 при каждом перезапуске программы....????

Файл текстовой.

← →
Alexey © (2004-04-22 09:41) [0]

← →
Алхимик © (2004-04-22 09:50) [1]

var num : integer; str : string; FName : string; begin FName := <имя файла>; str := Copy(FName,Lenght(FName)-1,1); try num := StrToInt(str); except <сообщение об ошибке> exit; end; num := num + 1; str := IntToStr(num); if Lenght(str) > 1 then str := str[2]; FName[Length(FName)-1] := Char(str); end;

Писал на коленке. Возможны ошибки.

← →
Алхимик © (2004-04-22 09:50) [1]

← →
Андрей Сенченко © (2004-04-22 09:53) [2]

Alexey © (22.04.04 09:41)

Этого хватит всего на 10 перезапусков программы

Алхимик © (22.04.04 09:50) [1]

А FName откуда возьмется ? Проще в инихе или реестре хранить.

← →
Андрей Сенченко © (2004-04-22 09:53) [2]

← →
Alexey © (2004-04-22 09:57) [3]

мужики конкретно по теме ... файл берется с харда как я тебе его задам Алхимик

← →
Alexey © (2004-04-22 09:57) [3]

мужики конкретно по теме ... файл берется с харда как я тебе его задам Алхимик

Alexey © (22.04.04 09:57) [3]

Конкретно по теме.
Сделай иниху, в которой будешь хранить последнюю использованную тобой цифирьку. При инциализации приложения - читай ее. При выходе из приложения - пиши новую

С раширением работай через ChangeFileExt()

Еще конкретнее нужно ?

Думаю разберешся, fMaxFile для циклической записи например на неделю. Работает даже при изменении и удалении файлов.
unit uManageFile;

interface

Type
TManageFile = class
private
fBase, fPath: String;
FName: Array of Integer;
procedure DeleteMax;
function Sort(var A: array of Integer): Boolean;
procedure GetFiles;
procedure ChangeMax;
Public
fMaxFile: Byte;
fExt: String;
function NextPart(Base, Path: String): String;
constructor Create;
end;

implementation
uses Sysutils, FileCtrl;

constructor TManageFile.Create;
begin
inherited;
fMaxFile := 7;
fExt := ".zip";
end;

procedure TManageFile.GetFiles;
Var FileCount, i, Len: Integer;
sr: TSearchRec;
Step: Integer;
begin
FileCount := 0;
Step := 50;
SetLength(FName,Step);

FindFirst(fPath+"\"+fBase+"*"+fExt, faAnyFile, sr);
repeat
if (fBase = Copy(sr.Name,1,Length(fBase))) and (ExtractFileExt(sr.Name)=fExt) then begin
Len := Length(sr.Name)-Length(ExtractFileExt(sr.Name))-Length(fBase);
i := StrToInt(Copy(sr.Name,Length(fBase)+1,Len));
Inc(FileCount);
FName[FileCount-1] := i;
if FileCount > High(FName)-10 then SetLength(FName,High(FName)+Step);
end;
until FindNext(sr) > 0;
FindClose(sr);
SetLength(FName,FileCount);

end;

function TManageFile.NextPart(Base, Path: String): String;
Var Size: Integer;
Index: Byte;
begin
fPath := Path;
fBase := Base;

if Not DirectoryExists(fPath) then
if not ForceDirectories(fPath) then raise Exception.Create("Cannot create "+fPath);

GetFiles;
Sort(FName);
Size := Length(FName);
if Size = 0 then
Index := 1
else if Size >= fMaxFile then begin
DeleteMax;
ChangeMax;
Index := FName[Low(FName)];
end else begin
if FName[Low(FName)] = 1 then begin
ChangeMax;
Index := 1;
end else Index := FName[Low(FName)]-1;
end;
Result := fPath+"\"+fBase+IntToStr(Index)+fExt;
end;

procedure TManageFile.ChangeMax;
Var i: Integer;
begin
for i := High(FName) downto Low(FName) do
RenameFile( fPath+"\"+fBase+IntToStr(FName[i])+fExt, fPath+"\"+fBase+IntToStr(FName[i]+1)+fExt);
end;

procedure TManageFile.DeleteMax;
Var i: Integer;
begin
for i := High(FName) downto fMaxFile-1 do
DeleteFile( fPath+"\"+fBase+IntToStr(FName[i])+fExt );
end;

function TManageFile.Sort(var A: array of Integer): Boolean;

procedure QuickSort(var A: array of Integer; iLo, iHi: Integer);
var
Lo, Hi, Mid, T: Integer;
begin
Lo := iLo;
Hi := iHi;
Mid := A[(Lo + Hi) div 2];
repeat
while A[Lo] < Mid do Inc(Lo);
while A[Hi] > Mid do Dec(Hi);
if Lo <= Hi then
begin
T := A[Lo];
A[Lo] := A[Hi];
A[Hi] := T;
Inc(Lo);
Dec(Hi);
end;
until Lo > Hi;
if Hi > iLo then QuickSort(A, iLo, Hi);
if Lo < iHi then QuickSort(A, Lo, iHi);
end;

begin
Result := Length(A) > 0;
if Result then
QuickSort(A, Low(A), Length(A));
end;

end.

расширения файла Найти похожие ветки