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

[Fly5]

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



Код:

Код: Выделить всё

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.

Все работает, но программа копирует файл не в тот же каталог, где находится исходный файл, а в тот, в котором находится папка, имя которой мы даем файлу. Помогите плиз

[opel431]

Можно ждать решение проблемы, а можно вспомнить о процедуре GetCurrentDir и самому посмотреть "когда происходит изменение текущего каталога", ну и вернуть все в нужное русло SetCurrentDir.

Вообще по куску кода понять трудно...если OpenDialog1, то где OpenDialog1.Execute, так как, fullFileName, это локальная переменная. CreateShoRtCut наверное своя и что в ней, неизвестно, а это, в свою очередь, связанно с правильной передачей паскалевских строк в виде PChar в функции, которые будут их модифицировать.

Как-то так!

[opel431]

opel431, GetCurrentDir показывает правильную директорию, видимо все связано с переименованием, уже думаю как применить movefile, правда совсем не ясно, как это сделать, если папка каждый раз разная

[Fly5]

Цитата Fly5:



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

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

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

Искать, самое занятное в процессе!




Цитата Fly5:



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

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

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



Ну, что, выяснили что у Вас в 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.

[opel431]

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

[Fly5]

Цитата Fly5:



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

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

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



Код:

Код: Выделить всё

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

[opel431]

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

[Fly5]

Цитата Fly5:



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

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

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

[opel431]

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

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]

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

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.

.