[opel431]

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

[Fly5]

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

[opel431]

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.

[Fly5]

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

[opel431]

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

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

Код:

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]

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

[opel431]

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

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

[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.

.

[Fly5]

opel431, спасибо большое, сам бы я не дошел до этого. Единственное что получается, что ярлык имеет не полное имя папки, а лишь ее часть и у ярлыка остается в имени расширение файла, какой параметр отвечает за полное имя папки? Еще хочется второй вариант попробовать, создать копию файла с новым окончанием, не добавляя имя папки, а уже при создании ярлыка присвоить ярлыку имя папки.(Проще говоря изменить только код создания ярлыка) Этот код

Код:

StrTemp := copy(ChangeFileExt(StrTemp, ''), pos('\', StrTemp) + 1, length(ChangeFileExt(StrTemp, '')) - pos('\', StrTemp));

вызвал у меня тихих ужас, честно говоря ничего не понял, что он делает, ну да это уже мои проблемы. Просто еще хотел бы спросить совета какие книжки почитать? Вроде все советуют Фленова, ну у всех мнения разные.