• Что бы вступить в ряды "Принятый кодер" Вам нужно:
    Написать 10 полезных сообщений или тем и Получить 10 симпатий.
    Для того кто не хочет терять время,может пожертвовать средства для поддержки сервеса, и вступить в ряды VIP на месяц, дополнительная информация в лс.

  • Пользаватели которые будут спамить, уходят в бан без предупреждения. Спам сообщения определяется администрацией и модератором.

  • Гость, Что бы Вы хотели увидеть на нашем Форуме? Изложить свои идеи и пожелания по улучшению форума Вы можете поделиться с нами здесь. ----> Перейдите сюда
  • Все пользователи не прошедшие проверку электронной почты будут заблокированы. Все вопросы с разблокировкой обращайтесь по адресу электронной почте : info@guardianelinks.com . Не пришло сообщение о проверке или о сбросе также сообщите нам.

Delphi: Открыть Файл С Ожиданием Завершения Его Редактирования

Sascha Оффлайн

Sascha

Заместитель Администратора
Команда форума
Администратор
Регистрация
9 Май 2015
Сообщения
1,562
Баллы
155
Функция позволяет открыть файл в приложении, ассоциированном с его расширением, и дождаться завершения редактирования.

Код:
uses Shellapi;
...
function StartAssociatedExe(ExFName: WideString; var ErrorCode: Cardinal): Boolean;
var Prg: WideString;
    ProcessInfo: TProcessInformation;
    StartupInfo: TStartupInfo;
begin
  SetLength(Prg, MAX_PATH);
  Result := False;
  ErrorCode := FindExecutable(PChar(ExFName), nil, PChar(Prg));
  if ErrorCode >= 32 then
  begin
    SetLength(Prg, StrLen(PChar(Prg)));
    FillChar(StartupInfo, SizeOf(TStartupInfo), 0);
    with StartupInfo do
    begin
      cb := SizeOf(TStartupInfo);
      wShowWindow := SW_SHOW;
    end;
    if CreateProcess(nil, PWideChar(Format('%s "%s"', [Prg, ExFName])),
      nil, nil, False, NORMAL_PRIORITY_CLASS, nil, nil, StartupInfo, ProcessInfo) then
    begin
      WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
      GetExitCodeProcess(ProcessInfo.hProcess, ErrorCode);
      CloseHandle(ProcessInfo.hProcess);
      CloseHandle(ProcessInfo.hThread);
      Result := True;
    end
    else
      ErrorCode := GetLastError;
  end;
end;
Пример использования:
Код:
procedure TForm1.Button1Click(Sender: TObject);
var ErrorCode: Cardinal;
begin
  StartAssociatedExe('c:\test.doc', ErrorCode);
end;
 
Вверх Снизу