Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Delphi: Общие вопросы > Поиск каталога

Автор: MacTep 13.9.2004, 21:11

Помогите с таким вопросом: как узнать, есть ли в какой-то определенной папке (допустим, в папке c:\delphi7\) другая папка (допустим, MyWork)? И если этой папки не существует, то создать ее?! Спасибо!

Автор: p0s0l 13.9.2004, 22:39

Попробуй так:
ForceDirectories ('c:\delphi7\MyWork');
так создастся папка MyWork, если её не было...

Можно еще так:
проверка существования папки:
DirectoryExists ('c:\delphi7\MyWork');
создание папки:
CreateDir ('c:\delphi7\MyWork');

Автор: MacTep 13.9.2004, 22:55

Так, с этим вопросом вроде бы все понял, даже работает, спасибо

!!! А теперь мне интересно, как сделать, чтобы на экране появилось окно (диалог) для выбора каталога (например, как при установки программы). А еще интересно, как можно у этого диалога изменить координаты его положения на экране. Подскажите, плиз!

Автор: Illusion Dolphin 13.9.2004, 23:48

Диалоги:

Код


unit acDlgSelect;

interface

uses Windows;

function SelectDirPlus(hWnd: HWND; const Caption: string; const SelRot: String = ''; const Root: WideString = ''): String;
// Диалог выбора директории с кнопкой "Создать папку"

function SelectDir(hWnd: HWND; const Caption: String; const SelRot: String = ''): String;
// Диалог выбора директории

function ChangeIconDialog(hOwner :tHandle; var FileName: string; var IconIndex: Integer): Boolean;
// Диалог выбора иконки

implementation

uses
   SysUtils , ShlObj, ActiveX, Forms, SysConst;
// -----------------------------------------------------------------
threadvar
 myDir: string;

function BrowseCallbackProc(hwnd: HWND; uMsg: UINT; lParam: LPARAM; lpData: LPARAM): integer; stdcall;
begin
 Result := 0;
 if uMsg = BFFM_INITIALIZED then
   SendMessage(hwnd, BFFM_SETSELECTION, 1, LongInt(PChar(myDir)));
end;

function SelectDirPlus(hWnd: HWND; const Caption: string; const SelRot: String = ''; const Root: WideString = ''): String;
// Диалог выбора директории с кнопкой "Создать папку"
var
 WindowList: Pointer;
 BrowseInfo : TBrowseInfo;
 Buffer: PChar;
 RootItemIDList, ItemIDList: PItemIDList;
 ShellMalloc: IMalloc;
 IDesktopFolder: IShellFolder;
 Eaten, Flags: LongWord;
 Cmd: Boolean;
begin
 Result:= SelRot;
 FillChar(BrowseInfo, SizeOf(BrowseInfo), 0);
 if DirectoryExists(SelRot) then myDir:= SelRot;
 if (ShGetMalloc(ShellMalloc) = S_OK) and (ShellMalloc <> nil) then begin
   Buffer := ShellMalloc.Alloc(MAX_PATH);
   try
     RootItemIDList := nil;
     if Root <> '' then begin
       SHGetDesktopFolder(IDesktopFolder);
       IDesktopFolder.ParseDisplayName(hWnd, nil, POleStr(Root),
                                       Eaten, RootItemIDList, Flags);
     end;
     with BrowseInfo do begin
       hwndOwner:=       hWnd;
       pidlRoot:=        RootItemIDList;
       pszDisplayName:=  Buffer;
       lpfn:=            @BrowseCallbackProc;
       lpszTitle:=       PChar(Caption);
       ulFlags:=         BIF_RETURNONLYFSDIRS or BIF_NEWDIALOGSTYLE or
                         BIF_EDITBOX or BIF_STATUSTEXT;
     end;
     WindowList:= DisableTaskWindows(0);
     try
       ItemIDList:= ShBrowseForFolder(BrowseInfo);
     finally
       EnableTaskWindows(WindowList);
     end;
     Cmd:= ItemIDList <> nil;
     if Cmd then begin
       ShGetPathFromIDList(ItemIDList, Buffer);
       ShellMalloc.Free(ItemIDList);
       if Length(Buffer) <> 0 then
         Result:= IncludeTrailingPathDelimiter(Buffer)
       else
         Result:= '';
     end;
   finally
     ShellMalloc.Free(Buffer);
   end;
 end;
end;
// -----------------------------------------------------------------
function SelectDir(hWnd: HWND; const Caption: String; const SelRot: String = ''): String;
// Диалог выбора директории
var
 lpItemID:    PItemIDList;
 BrowseInfo:  TBrowseInfo;
 TempPath:    array[0..MAX_PATH] of char;
begin
 Result:= SelRot;
 FillChar(BrowseInfo, sizeof(TBrowseInfo), 0);
 if DirectoryExists(SelRot) then myDir:= SelRot;
 with BrowseInfo do begin
   hwndOwner:= hWnd;
   lpszTitle:= PChar(Caption);
   lpfn:=      @BrowseCallbackProc;
   ulFlags:=   BIF_RETURNONLYFSDIRS;
 end;
 lpItemID:= SHBrowseForFolder(BrowseInfo);
 if lpItemId <> nil then begin
   SHGetPathFromIDList(lpItemID, TempPath);
   Result:= IncludeTrailingPathDelimiter(TempPath);
 end;
 GlobalFreePtr(lpItemID);
end;
// -----------------------------------------------------------------
function ChangeIconDialog(hOwner :tHandle; var FileName: string; var IconIndex: Integer): Boolean;
// Диалог выбора иконки
type
 SHChangeIconProc = function(Wnd: HWND; szFileName: PChar; Reserved: Integer;
   var lpIconIndex: Integer): DWORD; stdcall;
 SHChangeIconProcW = function(Wnd: HWND; szFileName: PWideChar;
   Reserved: Integer; var lpIconIndex: Integer): DWORD; stdcall;
const
 Shell32 = 'shell32.dll';
var
 ShellHandle: THandle;
 SHChangeIcon: SHChangeIconProc;
 SHChangeIconW: SHChangeIconProcW;
 Buf:  array [0..MAX_PATH] of Char;
 BufW: array [0..MAX_PATH] of WideChar;
begin
 Result:= False;
 SHChangeIcon:= nil;
 SHChangeIconW:= nil;

 ShellHandle:= Windows.LoadLibrary(PChar(Shell32));
 try
   if ShellHandle <> 0 then begin
     if Win32Platform = VER_PLATFORM_WIN32_NT then
       SHChangeIconW:= GetProcAddress(ShellHandle, PChar(62))
     else
       SHChangeIcon:=  GetProcAddress(ShellHandle, PChar(62));
   end;

   if Assigned(SHChangeIconW) then begin
     StringToWideChar(FileName, BufW, SizeOf(BufW));
     Result:= SHChangeIconW(hOwner, BufW, SizeOf(BufW), IconIndex) = 1;
     if Result then
       FileName:= BufW;
   end
   else if Assigned(SHChangeIcon) then begin
     StrPCopy(Buf, FileName);
     Result:= SHChangeIcon(hOwner, Buf, SizeOf(Buf), IconIndex) = 1;
     if Result then FileName:= Buf;
   end
   else
     raise Exception.Create(SUnkOSError);
 finally
   if ShellHandle <> 0 then FreeLibrary(ShellHandle);
 end;
end;
// -----------------------------------------------------------------
end.

Автор: Pakshin A. S. 14.9.2004, 18:32

А что так сложно с диалогом?
1) Можно своими рукам создать: компонентов полно
2)

Код


var
 Dir1, Dir2:string;
begin
 Dir1:='C:\'
 Dir2:='';
 SelectDirectory('Выбор папки', Dir1, Dir2);
end;

Автор: MacTep 14.9.2004, 22:18

Самое интересное в этом вопросе - это позиционирование диалога SelectDirectory на экране. Почему он всегда вылезает только в низу экрана? Я хочу, чтобы он было по середине!

Автор: Pakshin A. S. 15.9.2004, 21:39

Тогда - выбирай пунтк первый. Реализация займет не более 15 минут!!!

Вкладка Win 3.1!

Автор: MacTep 15.9.2004, 22:58

а подробнее?! про пункт первый!!! и про вкладку win 3.1

Автор: Pakshin A. S. 16.9.2004, 20:32

Во влкадке есть компоненты:
DriveComboBox
DirectoryListBox

Наладив связки, без труду получаем диалог.

Можно юзать:
Samples -> ShellTreeView
Это посовременнее...

Автор: Pakshin A. S. 16.9.2004, 21:03

Делаем такую форму:

Код


object Dialog: TDialog
  Left = 192
  Top = 114
  Width = 282
  Height = 282
  Caption = 'Dialog'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  Position = poScreenCenter
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 8
    Top = 8
    Width = 30
    Height = 13
    Caption = 'Диск:'
  end
  object DirectoryListBox1: TDirectoryListBox
    Left = 8
    Top = 32
    Width = 257
    Height = 177
    ItemHeight = 16
    TabOrder = 0
  end
  object DriveComboBox1: TDriveComboBox
    Left = 43
    Top = 6
    Width = 222
    Height = 19
    DirList = DirectoryListBox1
    TabOrder = 1
  end
  object Button1: TButton
    Left = 8
    Top = 216
    Width = 75
    Height = 25
    Caption = 'OK'
    TabOrder = 2
    OnClick = Button1Click
  end
  object Button2: TButton
    Left = 192
    Top = 216
    Width = 75
    Height = 25
    Caption = 'Cancel'
    TabOrder = 3
    OnClick = Button2Click
  end
end

Не претендую на красоту...

А вот и сам юнит:

Код


unit U_Dialog;

{
Use like this

begin
 if NewDialog.Execute('Select directory', ExtractFileDir(Application.ExeName))
  then
   ShowMessage(NewDialog.DirName);
}

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, ShellCtrls, StdCtrls, FileCtrl;

type
  TNewDialog = object
   DirName:string;
   function Execute(const Name:string; const DefDir:string):boolean;
  end;
  TDialog = class(TForm)
    DirectoryListBox1: TDirectoryListBox;
    DriveComboBox1: TDriveComboBox;
    Label1: TLabel;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
 NewDialog: TNewDialog;

implementation

{$R *.dfm}

var
 Dialog: TDialog;
 DirNameEx:boolean;

function TNewDialog.Execute(const Name:string; const DefDir:string):boolean;
begin
 DirNameEx:=False;
 DirName:='';
 Result:=False;
 Dialog:=TDialog.Create(self);
 with Dialog do
  begin
   Position:=poScreenCenter;
   Caption:=Name;
   DriveComboBox1.Drive:=DefDir[1];
   DirectoryListBox1.Directory:=DefDir;
   ShowModal
  end;
 if DirNameEx
  then
   begin
    Result:=True;
    DirName:=Dialog.DirectoryListBox1.Directory
   end;
 Dialog.Free
end;

procedure TDialog.Button1Click(Sender: TObject);
begin
 DirNameEx:=True;
 Close
end;

procedure TDialog.Button2Click(Sender: TObject);
begin
 Close
end;

end.

Автор: MacTep 17.9.2004, 10:44

Большое спасибо!

Автор: Alex 17.9.2004, 19:28

Illusion Dolphin, а копирайт вырезать не хорошо

Прошу прощения за флуд

Автор: Pakshin A. S. 17.9.2004, 19:44

Цитата(MacTep @ 17.9.2004, 11:44)

Большое спасибо!

Рад помочь.

Автор: Illusion Dolphin 17.9.2004, 20:11

Цитата

а копирайт вырезать не хорошо

Я знаю, что это с этого форума, но, увы, копирайт у меня не сохранился

... Так и лежит файлик без ничего... Насколько я понимаю, это твоё?
P.S. Извиняюсь за продолжение оффтопа

Автор: Alex 17.9.2004, 20:30

Цитата(Illusion @ 17.9.2004, 21:11)

Насколько я понимаю, это твоё?

угу

Автор: Georg4 20.9.2004, 11:14

Alex
НЕсмотря ни на какой копирайт, код хороший так что ты прославился ещё раз, будучи беззвестным автором сего исходника.
Извиняюсь за оффтоп прогрессирующий здесь

Автор: skorpik 21.9.2009, 09:27

Ребята, может есть где у кого компонент TFinder? (также поиск файлов, каталогов) Но никак не могу его найти, а очень надо... Помнится был когд-то у меня, но нету. Помогите плиз у кого есть он. Спасибо заранее...