Присвоить файлу имя папки в которой он находится

Компьютерный форум OSzone.net (http://forum.oszone.net/index.php)

- Программирование и базы данных (http://forum.oszone.net/forumdisplay.php?f=21)

Присвоить файлу имя папки в которой он находится

Здравствуйте, возникли трудности. Нужно чтобы при клике по кнопке программа создавала копию файла из указанной директории, переименовала ее(присвоив имя каталога, в котором находится) и создавала ярлык на рабочем столе

Код:

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, правда совсем не ясно, как это сделать, если папка каждый раз разная

Цитата:

Цитата Fly5

GetCurrentDir показывает правильную директорию »

Так речь идет о кусках кода! Например, для чего у Вас компонент Edit1, что в нем "Text", откуда берется. Можно и нужно посмотреть, что у Вас после присваивания в переменных fullFileName, CommDesk, NewName и так далее - типа, копируйте например с if CopyFile...then и выводите в результат ShowMessage(NewName), проверяйте существование if FileExists.....then. Практически включите предусмотренные функциями ловушки ошибок и информативность при их выявлении.
Искать, самое занятное в процессе!

Цитата:

Цитата Fly5

правда совсем не ясно, как это сделать, если папка каждый раз разная »

А переменные для чего? Запоминаете путь к выбранной, полученной, заданной папке в некой глобальной переменной и используете там где нужно.

Ну, что, выяснили что у Вас в NewName....?

Некрасивый способ показать где ошибка, но для примера

NewName выдает все верно, что самое то странное. Добавил форму, чтобы было нагляднее. Пробовал по разному и как у вас тоже, но упорно сохраняется в другой папке, либо в нужной без имени папки, но лишь с окончанием _newnewfile.rar.

Цитата:

Цитата Fly5

Пробовал по разному и как у вас тоже »

Пробовали, но не так! Обратите внимание на глобальные переменные, доступные в других процедурах и функциях в вашем проекте

Код:

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), увидите разницу.

Пробовал по всякому или получается один ярлык, но нет файла, либо файл с ярлыком, но в другой папке и эту чертову переменную примерял по всякому, как мне кажется. Подскажите лучше тогда как ярлыку присвоить имя папки, это попроще будет чем все эти дебри

Цитата:

Цитата Fly5

это попроще будет чем все эти дебри »

Дебри нужно разгребать иначе ни к чему потом не придете! С планшета править Ваш проект не могу, возможно посмотрю днем, но соберитесь и реализуйте так, как Вам было предложено. Нет ничего приятней, чем решить задачу с а м о м у!

Не знаю Ваши планы, но я бы решал задачу так вместо завтрака и отдыха после ночной, оставляя Вашу основу:

Unit1.pas

Код:

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.вызвал у меня тихих ужас, честно говоря ничего не понял, что он делает....Нужно читать комментарии

Цитата:

Цитата opel431

// получаем имя последнего каталога пути к файлу, не весь же путь тащить в имя нового файла »

Это, как раз ответ на Ваш вопрос - какой параметр отвечает за полное имя папки? Убирайте и получайте полное название вложений. Но, допустим, Вы копируете из каталог с десятком вложений, что и файлу присвоите название в виде - бла\бла\бла\бла\бла\бла\бла\бла\бла\бла?
3. О комментариях уже сказал

Цитата:

Цитата opel431

sExt := ExtractFileExt(FullFileName);// расширение файла источника »

Т.е, мы сохраняем расширение файла источника, чтобы впоследствии восстановить с новым именем файла. Если у Вас есть планы менять расширение (думаю, не .txt на .rar), то убираете эту строку и изменяем эту, например так, Edit1.Text := StrTemp + '_NewFile.rar'; .
4.Какие книжки почитать? Я, не профессионал и потому читаю все, что интересно или приведет к решению возникшей задачи.