Модераторы: Poseidon, Snowy, bems, MetalFan

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Поиск каталога, помогите 
:(
    Опции темы
MacTep
Дата 13.9.2004, 21:11 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1292
Регистрация: 4.8.2003
Где: г. Самара

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


--------------------
(A)bort, (R)etry, (I)gnore = Haфиг, Heфиг, Пoфиг ... :)
PM MAIL   Вверх
p0s0l
Дата 13.9.2004, 22:39 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Г-н Посол
****


Профиль
Группа: Экс. модератор
Сообщений: 3668
Регистрация: 13.7.2003
Где: 58°38' с.ш. 4 9°41' в.д.

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

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


Это сообщение отредактировал(а) p0s0l - 13.9.2004, 22:43


--------------------
С уважением, г-н Посол.
PM   Вверх
MacTep
Дата 13.9.2004, 22:55 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1292
Регистрация: 4.8.2003
Где: г. Самара

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


--------------------
(A)bort, (R)etry, (I)gnore = Haфиг, Heфиг, Пoфиг ... :)
PM MAIL   Вверх
Illusion Dolphin
Дата 13.9.2004, 23:48 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Участник Клуба
Сообщений: 1198
Регистрация: 3.5.2003

Репутация: 36
Всего: 63
Диалоги:
Код

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.





--------------------
В мире всего две бесконечности: вселенная и человеческая глупость... На счёт вселенной я не уверен.
Шифрование и организация фотографий - Photo Database 4.5
PM MAIL WWW ICQ   Вверх
Pakshin A. S.
Дата 14.9.2004, 18:32 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Участник Клуба
Сообщений: 5056
Регистрация: 16.2.2003

Репутация: 21
Всего: 61
А что так сложно с диалогом?
1) Можно своими рукам создать: компонентов полно
2)
Код

var
Dir1, Dir2:string;
begin
Dir1:='C:\'
Dir2:='';
SelectDirectory('Выбор папки', Dir1, Dir2);
end;
PM   Вверх
MacTep
Дата 14.9.2004, 22:18 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1292
Регистрация: 4.8.2003
Где: г. Самара

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


--------------------
(A)bort, (R)etry, (I)gnore = Haфиг, Heфиг, Пoфиг ... :)
PM MAIL   Вверх
Pakshin A. S.
Дата 15.9.2004, 21:39 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Участник Клуба
Сообщений: 5056
Регистрация: 16.2.2003

Репутация: 21
Всего: 61
Тогда - выбирай пунтк первый. Реализация займет не более 15 минут!!! biggrin.gif
Вкладка Win 3.1!
PM   Вверх
MacTep
Дата 15.9.2004, 22:58 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1292
Регистрация: 4.8.2003
Где: г. Самара

Репутация: 4
Всего: 4
а подробнее?! про пункт первый!!! и про вкладку win 3.1


--------------------
(A)bort, (R)etry, (I)gnore = Haфиг, Heфиг, Пoфиг ... :)
PM MAIL   Вверх
Pakshin A. S.
Дата 16.9.2004, 20:32 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Участник Клуба
Сообщений: 5056
Регистрация: 16.2.2003

Репутация: 21
Всего: 61
Во влкадке есть компоненты:
DriveComboBox
DirectoryListBox

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

Можно юзать:
Samples -> ShellTreeView
Это посовременнее...
PM   Вверх
Pakshin A. S.
  Дата 16.9.2004, 21:03 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Участник Клуба
Сообщений: 5056
Регистрация: 16.2.2003

Репутация: 21
Всего: 61
Делаем такую форму:
Код

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.


Это сообщение отредактировал(а) Pakshin A. S. - 16.9.2004, 21:06
PM   Вверх
MacTep
Дата 17.9.2004, 10:44 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1292
Регистрация: 4.8.2003
Где: г. Самара

Репутация: 4
Всего: 4
Большое спасибо!


--------------------
(A)bort, (R)etry, (I)gnore = Haфиг, Heфиг, Пoфиг ... :)
PM MAIL   Вверх
Alex
Дата 17.9.2004, 19:28 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Экс. модератор
Сообщений: 4147
Регистрация: 25.3.2002
Где: Москва

Репутация: 80
Всего: 162
Illusion Dolphin, а копирайт вырезать не хорошо hmmm.gif

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


--------------------
Написать можно все - главное четко представлять, что ты хочешь получить в конце. 
PM Skype   Вверх
Pakshin A. S.
Дата 17.9.2004, 19:44 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Участник Клуба
Сообщений: 5056
Регистрация: 16.2.2003

Репутация: 21
Всего: 61
Цитата(MacTep @ 17.9.2004, 11:44)
Большое спасибо!

Рад помочь. biggrin.gif

PM   Вверх
Illusion Dolphin
Дата 17.9.2004, 20:11 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Участник Клуба
Сообщений: 1198
Регистрация: 3.5.2003

Репутация: 36
Всего: 63
Цитата
а копирайт вырезать не хорошо 

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


--------------------
В мире всего две бесконечности: вселенная и человеческая глупость... На счёт вселенной я не уверен.
Шифрование и организация фотографий - Photo Database 4.5
PM MAIL WWW ICQ   Вверх
Alex
Дата 17.9.2004, 20:30 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Экс. модератор
Сообщений: 4147
Регистрация: 25.3.2002
Где: Москва

Репутация: 80
Всего: 162
Цитата(Illusion @ 17.9.2004, 21:11)
Насколько я понимаю, это твоё?

угу


--------------------
Написать можно все - главное четко представлять, что ты хочешь получить в конце. 
PM Skype   Вверх
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Общие вопросы"
SnowyMetalFan
bemsPoseidon
Rrader

Запрещается!

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи

Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Snowy, MetalFan, bems, Poseidon, Rrader.
 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Общие вопросы | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.0798 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.