Dosyanýn yeni kopyasýný oluþturarak kayýt etmek

[cagri_85]

slm

örneðin bu kodda ;

Memo1.Lines.Save('C:\deneme\dosya1.txt');

þeklinde kayýt ediyorum ayný dizine fakar her kayýt ettiðimde üstüne yazýyor ben ayný dizine yeni kopyasýný oluþturarak kayýt etmesini istiyorum

dosya2,dosya3 þeklinde ayný dizine kayýt edilecek

[vkamadan]

Merhaba benzer bir konuda çalışmam olmuştu sn:husonet in geliştirdiği bir fonksiyonu da kullanark elde ettiğim bir function işinizi görecektir.

Kod: Tümünü seç

function TersCevir(no:String):String;
var
    Cevrilen:String;
    i:Integer;
Begin
    i:= 0;
    Cevrilen := '';
    For i := length(no) DownTo 1 Do
    Begin
        Cevrilen := Cevrilen + no[i];
    End;
    Result := Cevrilen;
End;


function Numarator(no: String): String;
var
    Nmr, Temp, Temp1:String;
    Temp2:Char;
    i, Tmp:Integer;
Begin
    nmr := TersCevir(no);
    i:= 0;
    while i < length(no) Do
    Begin
        i := i + 1;
        if nmr[i] = '9' Then
        begin
            nmr[i] := '0';
            continue;
        End
        Else
        if (nmr[i] < '9') and (nmr[i] >= '0') Then
        Begin
            Temp := inttostr(StrToInt(nmr[i]) + 1);
            Tmp := i;
            Break;
        end;
        if nmr[i] = 'Z' Then
        begin
            nmr[i] := 'A';
            continue;
        End
        Else
        if (nmr[i] < 'Z') or (nmr[i] >= 'A') Then
        Begin
            Temp := inttostr(ord(nmr[i]));
            Temp := intToStr(StrToInt(Temp) + 1);
            Temp := Chr(StrToInt(Temp));
            Tmp := i;
            Break;
        end;
    End;
    i:= 0;
    while i < length(no) do
    Begin
        i := i + 1;
        if tmp = i Then
            if (temp[1] <= '9') and (temp[1] >= '0')  Then
                nmr[i] := temp[1]
            Else
            Begin
                nmr[i] := Temp[1];
            End;
        nmr[i] := nmr[i];
    End;

    result := TersCevir(nmr);
End;

Yukarıdaki kod @husonet in alfanumerik olarak numara arttırıcı kodu örn M001A yı M001B yapar neyse aşağıdaki fonksiyon ise tam yolunu ve adını gönderdiğin dosyanın belirttiğin klasörde olup olmadığına bakar varsa bir o klasörde bulamayana kadar dosya adını değiştirir senin örneğinde dosya1,dosya2,dosya3... şeklinde,

Kod: Tümünü seç

function DosyaADiTespitEt(DA: String): String;
var
DName:String;
Konum:String;
Sonuc:String;
begin
Konum:=DA;
Da:=ExtractFileName(Da);
DName:=Copy(DA,1,Pos('.',DA)-1);
if FileExists(Konum) then DName:=Numarator(DName) else begin Result:=DA;Exit;end;
Sonuc:=ExtractFilePath(Konum)+DName+ExtractFileExt(DA);
Result:=DosyaADiTespitEt(Sonuc);
end;

Kullanımı ,

Kod: Tümünü seç

YeniDosyaAdı:=DosyaAdiTespitEt('c:\dosya1.txt');
//Sonuç duruma göre dosya1.txt yada sıradki neyse o olacaktır.

iyi çalışmalar.

[t-hex]

Kod: Tümünü seç

var
 i: integer;
begin
i:=1;
while not fileexists('c:\deneme\dosya'+inttostr(i)+'.txt') do inc(i);
memo1.lines.save('c:\deneme\dosya'+inttostr(i)+'.txt');
end;

kaydetmek istediğin dosya mevcut ise dosyanın numarısını bir arttırıp kaydedersen istediğin gibi olur heralde.

[cagri_85]

hepinize teþekkür ederim