Показать полную графическую версию : Присвоить файлу имя папки в которой он находится
Здравствуйте, возникли трудности. Нужно чтобы при клике по кнопке программа создавала копию файла из указанной директории, переименовала ее(присвоив имя каталога, в котором находится) и создавала ярлык на рабочем столе
procedure TForm1.Button2Click(Sender: TObject);
var
Pst: PChar;
fullFileName, CommDesk, NewName: string;
begin
fullFileName := OpenDialog1.FileName; //извлекаем полный путь к файлу
NewName:=ChangeFileExt(ExtractFileDir(fullFileName),'')+'_newfile.rar'; //создаем новое имя файла и добавляем окончание
CopyFile(PChar(Edit1.Text), PChar(NewName), false); //копируем файл с новым именем
GetMem(Pst,MAX_PATH+1);
try
SHGetSpecialFolderPath(0,Pst,CSIDL_COMMON_DESKTOPDIRECTORY,False);
CommDesk:=String(Pst);
CreateShotCut(NewName, CommDesk+'\'+ExtractFileName(NewName)+'.lnk', '');
finally
FreeMem(Pst);
end;
end.
Все работает, но программа копирует файл не в тот же каталог, где находится исходный файл, а в тот, в котором находится папка, имя которой мы даем файлу. Помогите плиз
Можно ждать решение проблемы, а можно вспомнить о процедуре GetCurrentDir и самому посмотреть "когда происходит изменение текущего каталога", ну и вернуть все в нужное русло SetCurrentDir.
Вообще по куску кода понять трудно...если OpenDialog1, то где OpenDialog1.Execute, так как, fullFileName, это локальная переменная. CreateShoRtCut наверное своя и что в ней, неизвестно, а это, в свою очередь, связанно с правильной передачей паскалевских строк в виде PChar в функции, которые будут их модифицировать.
Как-то так!
opel431, GetCurrentDir показывает правильную директорию, видимо все связано с переименованием, уже думаю как применить movefile, правда совсем не ясно, как это сделать, если папка каждый раз разная
GetCurrentDir показывает правильную директорию »
Так речь идет о кусках кода! Например, для чего у Вас компонент Edit1, что в нем "Text", откуда берется. Можно и нужно посмотреть, что у Вас после присваивания в переменных fullFileName, CommDesk, NewName и так далее - типа, копируйте например с if CopyFile...then и выводите в результат ShowMessage(NewName), проверяйте существование if FileExists.....then. Практически включите предусмотренные функциями ловушки ошибок и информативность при их выявлении.
Искать, самое занятное в процессе!
правда совсем не ясно, как это сделать, если папка каждый раз разная »
А переменные для чего? Запоминаете путь к выбранной, полученной, заданной папке в некой глобальной переменной и используете там где нужно.
Ну, что, выяснили что у Вас в NewName....?
var
...
FullFileName, FolderName: string;
...
procedure TForm1.Button1Click(Sender: TObject);
begin
if OpenDialog1.Execute then
begin
FullFileName := OpenDialog1.FileName;
FolderName:=ExtractFilePath(FullFileName);
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
Pst: PChar;
CommDesk, NewName: string;
begin
NewName :=Copy(ChangeFileExt(ExtractFileDir(fullFileName), '') + '_newfile.rar', 4, Length(ChangeFileExt(ExtractFileDir(fullFileName), '') + '_newfile.rar'));
...
ShowMessage( FolderName+NewName); // то, что Вам нужно, для второго параметра в функции CopyFile!
// для первого параметра, все преобразования, можно сделать при присвоении свойства Edit1.Text.
A можно покопаться в процедуре ProcessPath.
NewName выдает все верно, что самое то странное. Добавил форму, чтобы было нагляднее. Пробовал по разному и как у вас тоже, но упорно сохраняется в другой папке, либо в нужной без имени папки, но лишь с окончанием _newnewfile.rar.
Пробовал по разному и как у вас тоже »
Пробовали, но не так! Обратите внимание на глобальные переменные, доступные в других процедурах и функциях в вашем проекте
var
Form1: TForm1;
FullFileName, FolderName: string;
Просмотрел в блокноте Ваш код (на планшете более не могу ничем помочь). Вы ведь из примера не реализовали ничего!
Где FolderName? Как Вы сохраняете папку источник файла - загоняйте в переменную FolderName, как показано в примере, а в Edit1.Text := полный путь к файлу источнику, как у Вас.
Далее, как в примере NewName :=Copy(ChangeFileExt(ExtractFileDir(fullFileName), '') + '_newfile.rar', 4, Length(ChangeFileExt(ExtractFileDir(fullFileName), '') + '_newfile.rar')); (получаете нужное Вам имя с названием папки источник) и объединяйте с папкой хранящейся в переменной FolderName - CopyFile(PChar(Edit1.Text), PChar(FolderName+NewName), false);
Все упирается в отсутствии правильного сохранения самой папки источника и полного пути к файлу источнику!
Выведите через ShowMessage( FolderName+NewName) и ShowMessage(NewName), увидите разницу.
Пробовал по всякому или получается один ярлык, но нет файла, либо файл с ярлыком, но в другой папке и эту чертову переменную примерял по всякому, как мне кажется. Подскажите лучше тогда как ярлыку присвоить имя папки, это попроще будет чем все эти дебри
это попроще будет чем все эти дебри »
Дебри нужно разгребать иначе ни к чему потом не придете! С планшета править Ваш проект не могу, возможно посмотрю днем, но соберитесь и реализуйте так, как Вам было предложено. Нет ничего приятней, чем решить задачу с а м о м у!
Не знаю Ваши планы, но я бы решал задачу так вместо завтрака и отдыха после ночной, оставляя Вашу основу:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, XPMan, ShellApi, ShlObj, ActiveX, ComObj,
ExtCtrls;
type
TForm1 = class(TForm)
GroupBox1: TGroupBox;
XPManifest1: TXPManifest;
CheckBox1: TCheckBox;
GroupBox2: TGroupBox;
Edit1: TEdit;
Button1: TButton;
Button2: TButton;
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
FullFileName, FolderName: string;
implementation
{$R *.dfm}
procedure CreateShortCut(SourceFile, ShortCutName, SourceParams: String);
var
IUnk: IUnknown;
ShellLink: IShellLink;
ShellFile: IPersistFile;
WideStr: WideString;
tmpShortCutName: string;
i: Integer;
begin
IUnk := CreateComObject(CLSID_ShellLink);
ShellLink := IUnk as IShellLink;
ShellFile := IUnk as IPersistFile;
ShellLink.SetPath(PChar(SourceFile));
ShellLink.SetArguments(PChar(SourceParams));
ShellLink.SetWorkingDirectory(PChar(ExtractFilePath(SourceFile)));
ShortCutName := ChangeFileExt(ShortCutName, '.lnk');
if fileexists(ShortCutName) then
begin
ShortCutName := copy(ShortCutName, 1, length(ShortCutName) - 4);
i := 1;
repeat
tmpShortCutName := ShortCutName + '(' + inttostr(i) + ').lnk';
inc(i);
until not fileexists(tmpShortCutName);
WideStr := tmpShortCutName;
end
else
WideStr := ShortCutName;
ShellFile.Save(PWideChar(WideStr), False);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
sExt, StrTemp: string;
begin
OpenDialog1.InitialDir := 'C:\';
if OpenDialog1.Execute then
begin
FullFileName := OpenDialog1.FileName;
FolderName := ExtractFilePath(FullFileName); // путь к папке источнику
sExt := ExtractFileExt(FullFileName); // расширение файла источника
// получаем имя последнего каталога пути к файлу, не весь же путь тащить в имя нового файла
StrTemp := ChangeFileExt(ExtractFileDir(FullFileName), '');
while pos('\', StrTemp) > 0 do
StrTemp := copy(ChangeFileExt(StrTemp, ''), pos('\', StrTemp) + 1,
length(ChangeFileExt(StrTemp, '')) - pos('\', StrTemp));
// выводим в поле имя папки + новое имя файла+восстанавливаем расширение
Edit1.Text := StrTemp + '_NewFile' + sExt;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
Pst: PChar;
CommDesk, NewName: string;
begin
// имя файла до или после редактирования в поле
NewName := Edit1.Text;
// выбор, а вдруг передумал создавать
if Application.MessageBox(PChar(FolderName + NewName),
'Создать новый файл и ярлык', MB_OKCANCEL + MB_ICONQUESTION) = IDOK then
begin
// копируем файл с новым именем
CopyFile(PChar(FullFileName), PChar(FolderName + NewName), False);
// создаем ярлык
GetMem(Pst, MAX_PATH + 1);
try
SHGetSpecialFolderPath(0, Pst, CSIDL_COMMON_DESKTOPDIRECTORY, False);
CommDesk := String(Pst);
CreateShortCut(FolderName + NewName,
CommDesk + '\' + ExtractFileName(NewName) + '.lnk', '');
finally
FreeMem(Pst);
end;
end;
end;
end..
opel431, спасибо большое, сам бы я не дошел до этого. Единственное что получается, что ярлык имеет не полное имя папки, а лишь ее часть и у ярлыка остается в имени расширение файла, какой параметр отвечает за полное имя папки? Еще хочется второй вариант попробовать, создать копию файла с новым окончанием, не добавляя имя папки, а уже при создании ярлыка присвоить ярлыку имя папки.(Проще говоря изменить только код создания ярлыка) Этот код StrTemp := copy(ChangeFileExt(StrTemp, ''), pos('\', StrTemp) + 1, length(ChangeFileExt(StrTemp, '')) - pos('\', StrTemp)); вызвал у меня тихих ужас, честно говоря ничего не понял, что он делает, ну да это уже мои проблемы. Просто еще хотел бы спросить совета какие книжки почитать? Вроде все советуют Фленова, ну у всех мнения разные.
1. Я оставил весь Ваш код и внес изменения для получения нужного результата
2.вызвал у меня тихих ужас, честно говоря ничего не понял, что он делает....Нужно читать комментарии // получаем имя последнего каталога пути к файлу, не весь же путь тащить в имя нового файла »Это, как раз ответ на Ваш вопрос - какой параметр отвечает за полное имя папки? Убирайте и получайте полное название вложений. Но, допустим, Вы копируете из каталог с десятком вложений, что и файлу присвоите название в виде - бла\бла\бла\бла\бла\бла\бла\бла\бла\бла?
3. О комментариях уже сказалsExt := ExtractFileExt(FullFileName);// расширение файла источника »Т.е, мы сохраняем расширение файла источника, чтобы впоследствии восстановить с новым именем файла. Если у Вас есть планы менять расширение (думаю, не .txt на .rar), то убираете эту строку и изменяем эту, например так, Edit1.Text := StrTemp + '_NewFile.rar'; .
4.Какие книжки почитать? Я, не профессионал и потому читаю все, что интересно или приведет к решению возникшей задачи.
© OSzone.net 2001-2012
vBulletin v3.6.4, Copyright ©2000-2025, Jelsoft Enterprises Ltd.