Имя пользователя:
Пароль:
 

Показать сообщение отдельно

Аватара для opel431

Ветеран


Contributor


Сообщения: 1803
Благодарности: 714

Профиль | Отправить PM | Цитировать


Если не используете JCL библиотеку, то можно на ее примере, так

Код: Выделить весь код
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ShlObj, ShellAPI;

type
  TForm1 = class(TForm)
    btn1: TButton;
    procedure btn1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ ---------------------------------------------------------------------------------------------
  Функция: IsDirectory
  Входные параметры: const FileName: string
  Результат: Boolean - является ли указанный файл каталогом
  ------------------------------------------------------------------------------------------- }
function IsDirectory(const FileName: string): Boolean;
var
  R: DWORD;
begin
  R := GetFileAttributes(PChar(FileName));
  Result := (R <> DWORD(-1)) and ((R and FILE_ATTRIBUTE_DIRECTORY) <> 0);
end;

{ ---------------------------------------------------------------------------------------------
  Функция: OpenFolder  требует ShlObj, ShellAPI
  Входные параметры: const Path: string; Parent: THandle; Explore: Boolean
  Результат: Boolean - открыть проводник с указанной папкой в качестве корневой
  ------------------------------------------------------------------------------------------- }
function OpenFolder(const Path: string; Parent: THandle;
  Explore: Boolean): Boolean;
var
  Sei: TShellExecuteInfo;
begin
  Result := False;
  if IsDirectory(Path) then
  begin
    FillChar(Sei, SizeOf(Sei), #0);
    with Sei do
    begin
      cbSize := SizeOf(Sei);
      Wnd := Parent;
      if Explore then
        lpVerb := 'explore'
      else
        lpVerb := 'open';
      lpFile := PChar(Path);
      nShow := SW_SHOWNORMAL;
    end;
    // директива контролирует типы значений указателя @, а также совместимость типов указателя
    {$TYPEDADDRESS ON}
    Result := ShellExecuteEx(@Sei);
    {$IFNDEF TYPEDADDRESS_ON}
    {$TYPEDADDRESS OFF}
    {$ENDIF ~TYPEDADDRESS_ON}
  end;
end;

{Использование}
procedure TForm1.btn1Click(Sender: TObject);
begin
 OpenFolder('c:\Windows', 0, True);

// или с обработкой
{ 
if OpenFolder('c:\Windows', 0, True) then
     // обработка условия
}  
 end;

end.

-------
Хвала тому, кто встав среди камней, уча другого, сам будет умней.


Последний раз редактировалось opel431, 05-06-2015 в 04:08.


Отправлено: 18:38, 04-06-2015 | #6