PDA

View Full Version : Rename File



M110
پنج شنبه 04 اردیبهشت 1382, 06:07 صبح
سلام.

آقا من خودمو کشتم تا این کد واسم نام فایل رو سایز اون فایل بکنه ولی تاکنون موفق نشده ام وبا خطای ACCESS DINIDE مواجه میشوم.

ممنون میشم اگه منو راهنمایی کنین .



function GetDirSize(dir: string; subdir: Boolean): Longint;
var
rec: TSearchRec;
found: Integer;
f:File;
st:String;
begin
Result := 0;
if dir[Length(dir)] <> '\' then dir := dir + '\';
found := FindFirst(dir + '*.*', faAnyFile, rec);
while found = 0 do
begin
Inc(Result, rec.Size);
AssignFile(f, rec.Name);
st:=inttostr(rec.Size);
Rename(f,st);
if (rec.Attr and faDirectory > 0) and (rec.Name[1] <> '.') and (subdir = True) then
Inc(Result, GetDirSize(dir + rec.Name, True));
found := FindNext(rec);
end;
FindClose(rec);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
label1.Caption := FloatToStr(GetDirSize('C:\WIN98\Desktop\percent', False) / Sqr(1024)) + ' MBytes';
label2.Caption := FloatToStr(GetDirSize('C:\WIN98\Desktop\percent', True) / Sqr(1024)) + ' MBytes';
end;

Hidarneh
پنج شنبه 04 اردیبهشت 1382, 14:59 عصر
عزیز من خودکشی نداره که این کد اصلاح شده خودته که کاملا کار می کنه ولی حواست باشه اگه دو تا فایل سایز مساوی داشته باشن ...

function GetDirSize(dir: string; subdir: Boolean): Longint;
var
rec: TSearchRec;
found: Integer;
f:File;
st:String;
begin
Result := 0;
if dir[Length(dir)] <> '\' then dir := dir + '\';
found := FindFirst(dir + '*.*', faAnyFile, rec);
found := FindNext(rec);
found := FindNext(rec);
while found = 0 do
begin
Inc(Result, rec.Size);
AssignFile(f, dir+rec.Name);
st:=inttostr(rec.Size);
Rename(f,dir+st);
if (rec.Attr and faDirectory > 0) and (rec.Name[1] <> '.') and (subdir = True) then
Inc(Result, GetDirSize(dir + rec.Name, True));
found := FindNext(rec);
end;
FindClose(rec);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
label1.Caption := FloatToStr(GetDirSize('E:\Karimaiee', False) / Sqr(1024)) + ' MBytes';
label2.Caption := FloatToStr(GetDirSize('E:\Karimaiee', True) / Sqr(1024)) + ' MBytes';
end;

و اما تغییراتش:
اولا وقتی توی یه شاخه این کارو می کنی همیشه دو تا فایل اول رو باید رد کنی چرا که اون دو تا فایلهای . و .. هستند که با دستور dir داس می بینی و طبیعتا نمی تونی اونها رو تغییر نام بدی .
دوما عزیز فقط با اسم که نمی شه باید مسیر اون رو هم بدی.
موفق باشی

M110
پنج شنبه 04 اردیبهشت 1382, 20:38 عصر
سلام .متشکرم.کد شما عالی کار کرد

ا ما نمیدونم چرا این دلفی اینقدر به ما گیر میده .

من برای اینکه اسم و پسوند فایل هم به اون اضافه بشه تنها یه تغییر کوچولو دادم و Rename(f,dir+st); رو به Rename(f,dir+st+rec.Name); تغییر دادم.

حالا بجای اینکه سایز فایل رو یکبار تکرار کنه .چهاربار اونو مینویسه پشت اسم فایل!!! اینو دیگه چیکارش کنم!!؟



function GetDirSize(dir: string; subdir: Boolean): Longint;
var
rec: TSearchRec;
found: Integer;
f:File;
st:String;
begin
Result := 0;
if dir[Length(dir)] <> '\' then dir := dir + '\';
found := FindFirst(dir + '*.*', faAnyFile, rec);
found := FindNext(rec);
found := FindNext(rec);
while found = 0 do
begin
st:='';
Inc(Result, rec.Size);
AssignFile(f, dir+rec.Name);
st:=inttostr(rec.Size);
Rename(f,dir+st+rec.Name);
if (rec.Attr and faDirectory > 0) and (rec.Name[1] <> '.') and (subdir = True) then
Inc(Result, GetDirSize(dir + rec.Name, True));
found := FindNext(rec);
end;
FindClose(rec);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
label1.Caption := FloatToStr(GetDirSize('C:\WIN98\Desktop\percent', False) )+ ' MBytes';
label2.Caption := FloatToStr(GetDirSize('C:\WIN98\Desktop\percent', True) )+ ' MBytes';
end;
[code/]

Hidarneh
یک شنبه 07 اردیبهشت 1382, 17:32 عصر
من اونو واست درست کردم ولی روی زیر شاخه ها حسش نبود.


function GetDirSize(dir: string; subdir: Boolean): Longint;
var
rec: TSearchRec;
found: Integer;
f:File;
st:String;
i:integer;
begin
Result := 0;
if dir[Length(dir)] <> '\' then dir := dir + '\';
found := FindFirst(dir + '*.*', faAnyFile, rec);
found := FindNext(rec);
found := FindNext(rec);
while found =0 do begin
i:=FileGetAttr(dir+rec.name);
i:=i or faArchive;
FileSetAttr(dir+rec.Name,i);
found := FindNext(rec);
end;
FindClose(rec);
found := FindFirst(dir + '*.*', faAnyFile, rec);
found := FindNext(rec);
found := FindNext(rec);
while found = 0 do
begin
st:='';
Inc(Result, rec.Size);
AssignFile(f, dir+rec.Name);
st:=inttostr(rec.Size);
if ((FileGetAttr(dir+rec.name) and faArchive)<>0) then
Rename(f,dir+st+rec.Name);
i:=FileGetAttr(dir+st+rec.name);
i:=i xor faArchive;
FileSetAttr(dir+st+rec.Name,i);
if (rec.Attr and faDirectory > 0) and (rec.Name[1] <> '.') and (subdir = True) then
Inc(Result, GetDirSize(dir + rec.Name+'\', True));
found := FindNext(rec);
end;
FindClose(rec);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
label1.Caption := FloatToStr(GetDirSize('e:\karimaiee', False) )+ ' MBytes';
// label2.Caption := FloatToStr(GetDirSize('e:\karimaiee', True) )+ ' MBytes';
end;

موفق باشی

البته اینو بگم نمی دونم ایراد دلفی بود یا طبق معمول عمو بیلی . ولی بعضی از فایلها رو دو بار پیدا می کنه واسه همین این تغییرات رو توش دادم .