Форум по Delphi программированию



Вернуться   Форум по Delphi программированию > Все о Delphi > [ "Начинающим" ]
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 10.04.2014, 21:58
Аватар для Electronic_Arts
Electronic_Arts Electronic_Arts вне форума
Местный
 
Регистрация: 13.07.2006
Адрес: на земле
Сообщения: 554
Версия Delphi: XE5
Репутация: 18
Восклицание Подайте идею как перемещать самого себя

Столкнулся с такой проблемой...
Код:
function MoveDir(const fromDir, toDir: string): Boolean;
var
  fos: TSHFileOpStruct;
begin
  ZeroMemory(@fos, SizeOf(fos));
  with fos do
  begin
    wFunc  := FO_MOVE;
    fFlags := FOF_FILESONLY;
    pFrom  := PChar(fromDir + #0);
    pTo    := PChar(toDir)
  end;
  Result := (0 = ShFileOperation(fos));
end;

Когда программа сама тоже находится в перемещаемой папке то выскакивает окно что не получается перемешать файл так как он занять....если нажать кнопку ПРОПУСТИТЬ то все ОК перемещение заканчивается удачно...

Просто как можно при перемещении сделать так чтоб все переместилось без кроме самого ЕХЕ-шника чтоб избежать ошибку???
__________________
Нет ничего не возможного. Вопрос только во времени...
Ответить с цитированием
  #2  
Старый 10.04.2014, 22:03
Аватар для poli-smen
poli-smen poli-smen вне форума
Профессионал
 
Регистрация: 06.08.2012
Адрес: Кривой Рог
Сообщения: 1,791
Версия Delphi: Delphi 7, XE2
Репутация: 4415
По умолчанию

Цитата:
Сообщение от Electronic_Arts
Когда программа сама тоже находится в перемещаемой папке то выскакивает окно что не получается перемешать файл так как он занять....если нажать кнопку ПРОПУСТИТЬ то все ОК перемещение заканчивается удачно...

Просто как можно при перемещении сделать так чтоб все переместилось без кроме самого ЕХЕ-шника чтоб избежать ошибку???
Исключение можно подавить конструкцией try...except
Ответить с цитированием
Этот пользователь сказал Спасибо poli-smen за это полезное сообщение:
Electronic_Arts (12.04.2014)
  #3  
Старый 10.04.2014, 22:06
Аватар для Electronic_Arts
Electronic_Arts Electronic_Arts вне форума
Местный
 
Регистрация: 13.07.2006
Адрес: на земле
Сообщения: 554
Версия Delphi: XE5
Репутация: 18
Восклицание

Ща попробуем...спасибо

Что то не получается обходить ошибку
Код:
try
  if MoveDir(Src, Dst) = True then
    begin
    ...
    ...
    end;
 Except
{тут я понимаю что обрабатывается исключение но 
по моему моя ошибка выскакивает прежде чем дело доходит до сюда}
end;
Так как там же идет проверка НА САМОМ ЛИ ДЕЛЕ ВСЕ ПЕРЕМЕСТИЛОСЬ если да то идем дальше...
Или я что то не правильно делаю??
__________________
Нет ничего не возможного. Вопрос только во времени...

Последний раз редактировалось M.A.D.M.A.N., 11.04.2014 в 18:08.
Ответить с цитированием
  #4  
Старый 11.04.2014, 00:51
Аватар для poli-smen
poli-smen poli-smen вне форума
Профессионал
 
Регистрация: 06.08.2012
Адрес: Кривой Рог
Сообщения: 1,791
Версия Delphi: Delphi 7, XE2
Репутация: 4415
По умолчанию

Цитата:
Сообщение от Electronic_Arts
Что то не получается обходить ошибку
Да, это не исключение, это сообщение об ошибке отображает оболочка, поэтому try...except здесь не поможет.
В справке написано, что для того чтобы не отображались сообщения об ошибках нужно указать флаг FOF_NOERRORUI:
Код:
.....
    fFlags := FOF_FILESONLY or FOF_NOERRORUI;
.....
Ответить с цитированием
Этот пользователь сказал Спасибо poli-smen за это полезное сообщение:
Electronic_Arts (12.04.2014)
  #5  
Старый 11.04.2014, 01:10
Аватар для Electronic_Arts
Electronic_Arts Electronic_Arts вне форума
Местный
 
Регистрация: 13.07.2006
Адрес: на земле
Сообщения: 554
Версия Delphi: XE5
Репутация: 18
Восклицание

Спасибо за ссылку - ша посмотрю какой флаг за что отвечает...

В обычном значении fFlags := FOF_FILESONLY
получаю вот это




Если тут не нажать пропустить то я не получаю сообщение об удачном перемещении...

А если fFlags := FOF_FILESONLY or FOF_NOERRORUI получаю это



Хотя папка перемешаеться туда где никаких копий EXE-шника нету точнее файл создается при перемещении а потом система ругается типа уже есть и тут тоже если не нажать пропустить то я не получу сообщение об успешном переезде

Дело в том что мне и не нужно сам ЕХЕ-шник перемешать - достаточно чтоб все остальное перемешался удачно а сам ЕХЕ-шник игнорировался

У меня насчет этой проблемы всего две идеи

- написать дополнительный модуль которая по параметрам из основного ЕХЕшника будет выполнять перемещение запустив себя из другой папки...

Потом думаю можно словить хендл окна которая выскакивать и найти на нем кнопку "пропустить" и нажать..

- но как можно исключить при перемещении самого себя??
__________________
Нет ничего не возможного. Вопрос только во времени...

Последний раз редактировалось M.A.D.M.A.N., 11.04.2014 в 18:08.
Ответить с цитированием
  #6  
Старый 11.04.2014, 17:27
Аватар для Alegun
Alegun Alegun вне форума
LMD-DML
 
Регистрация: 12.07.2009
Адрес: Богородское
Сообщения: 3,025
Версия Delphi: D7E
Репутация: 1834
По умолчанию

Структуре TSHFileOpStruct в качестве параметра pFrom можно передать просто список файлов без экзешника (в виде PString т.е. имена идут через #0, в конце ещё + #0), тогда и исключений не будет
Код:
type
 TBuffer = array of Char;

procedure CreateBuffer(Names: TStrings; var P: TBuffer);
var
 i, j, l : integer;
begin
 for i := 0 to Names.Count-1 do
  begin
   l:= Length(P);
   SetLength(P, L+Length(Names[i])+1);
   for j := 0 to Length(Names[i])-1 do P[l+j]:= Names[i][j+1];
   P[l + j]:= #0;
  end;
 SetLength(P, Length(P)+1);
 P[Length(P)]:= #0;
end;

function MoveDir(const fromDir, toDir: string): Boolean;
var
 sr:  TSearchRec;
 fos: TSHFileOpStruct;
 fl:  TStrings;
 Buf: TBuffer;
begin
 fl:= TStringList.Create;
 if FindFirst(fromDir  + '*.*', faAnyFile, sr) = 0 then

  repeat

 if (sr.Name = '.') or (sr.name = '..') then Continue;
 if (sr.Attr and faDirectory) <> 0 then MoveDir(fromDir + sr.Name, toDir)
  else
   if sr.Name <> ExtractFileName(ParamStr(0)) then fl.Add(fromDir + sr.Name);

   until FindNext(sr) <> 0;

 FindClose(sr);

 CreateBuffer(fl, Buf);

 ZeroMemory(@fos, SizeOf(fos));
  with fos do
   begin
    wFunc  := FO_MOVE;
    fFlags := FOF_FILESONLY or FOF_NOCONFIRMMKDIR;
    pFrom  := Pointer(Buf);
    pTo    := PChar(toDir)
   end;

 Result:= (0 = ShFileOperation(fos));
 Buf:= nil;
 fl.Free;
end;
использование
Код:
if MoveDir(ExtractFileDir(ParamStr(0)) + '\', 'C:\TMP') then Caption:= 'Done';
немного страшновато выглядит, нету времени чтоб собрать что-то более элегантное, посему это то что в DRKB было. Проверил, работает
Ответить с цитированием
Этот пользователь сказал Спасибо Alegun за это полезное сообщение:
Electronic_Arts (12.04.2014)
  #7  
Старый 12.04.2014, 00:14
Аватар для Electronic_Arts
Electronic_Arts Electronic_Arts вне форума
Местный
 
Регистрация: 13.07.2006
Адрес: на земле
Сообщения: 554
Версия Delphi: XE5
Репутация: 18
Восклицание

Идеальный код..спасибо!!
__________________
Нет ничего не возможного. Вопрос только во времени...
Ответить с цитированием
  #8  
Старый 12.04.2014, 01:18
Аватар для Electronic_Arts
Electronic_Arts Electronic_Arts вне форума
Местный
 
Регистрация: 13.07.2006
Адрес: на земле
Сообщения: 554
Версия Delphi: XE5
Репутация: 18
Восклицание

Если кому то понадобиться то вот исправленный код

Код:
function MoveDir(const fromDir, toDir: string): Boolean;
var
 sr:  TSearchRec;
 fos: TSHFileOpStruct;
 fl:  TStrings;
 Buf: TBuffer;
 s1, s2, ToS: string;
begin
 fl:= TStringList.Create;
 if fromDir=ExtractFilePath(ParamStr(0)) then //Если ЕХЕ-шник в той же папке которую хотим переместить то
   begin
  if FindFirst(fromDir  + '*.*', faAnyFile, sr) = 0 then
 repeat
if (sr.Name = '.') or (sr.name = '..') then Continue;
 if (sr.Attr and faDirectory) <> 0 then 
 //MoveDir(fromDir + sr.Name, toDir) если это не поменять на
 fl.Add(fromDir + sr.Name) //то пустые папки в директории не перемещаются 
  else
   if sr.Name <> ExtractFileName(ParamStr(0)) then fl.Add(fromDir + sr.Name);
 until FindNext(sr) <> 0;
FindClose(sr);
 //Спросите тут почему не использовал POS
 //Просто чтоб избавить прогу от цикла
 s1:= ExtractFileDir(ParamStr(0));
 s2:= ExtractFilepath(ExtractFileDir(ParamStr(0)));
 delete(s1, 1, length(s2));
 ToS:=toDir+s1+'\'; //К пути куда идет перемещение добавляем Название папки с которого перемешаем файлы по отдельности
 end else // конец проверки пути ЕХЕ-ника
   begin
    fl.Add(fromDir); //Если ЕХЕ-шник не в той папке которую мы перемешаем то
    ToS := toDir; //Путь не меняем
   end;
 CreateBuffer(fl, Buf);
 
 ZeroMemory(@fos, SizeOf(fos));
  with fos do
   begin
    wFunc  := FO_MOVE;
    fFlags := FOF_FILESONLY or FOF_NOCONFIRMMKDIR;
    pFrom  := Pointer(Buf);
    pTo    := PChar(ToS)
   end;
 
 Result:= (0 = ShFileOperation(fos));
 Buf:= nil;
 fl.Free;
end;
__________________
Нет ничего не возможного. Вопрос только во времени...
Ответить с цитированием
  #9  
Старый 12.04.2014, 23:48
Аватар для Electronic_Arts
Electronic_Arts Electronic_Arts вне форума
Местный
 
Регистрация: 13.07.2006
Адрес: на земле
Сообщения: 554
Версия Delphi: XE5
Репутация: 18
Восклицание

С утра ломаю голову но ни как не могу определить
почему в моем коде - такая трабла

Если рядом EХЕ-шником одна пустая папка - то она не перемешается..
В пункте назначения создается папка с названием на котором лежит ЕХЕ-шник...но она пустая - внутр его должно перемешаться Та самая пустая папка но такого не происходит несмотря на то что с пункта полета она исчезает но в указанном месте не появляется...
А если создать две или несколько пустых папок то они все перемешаются без проблем - ну что это такое?????

Если рядом с ЕХЕ-шником вообще ничего нету то и папка на котором находиться запущенный ЕХЕшник не создается в пункте назначения - почему???
__________________
Нет ничего не возможного. Вопрос только во времени...
Ответить с цитированием
  #10  
Старый 13.04.2014, 00:38
Аватар для Alegun
Alegun Alegun вне форума
LMD-DML
 
Регистрация: 12.07.2009
Адрес: Богородское
Сообщения: 3,025
Версия Delphi: D7E
Репутация: 1834
По умолчанию

Так однако, про папки не было ни слова, только файлы Убрав рекурсивный вызов этой функции вы убили заодно и проход по вложенным папкам. Чтоб понять что присходит советую сделать следующее - на время заключите блок от строки с ZeroMemory.. до Result:= (0.. в фигурные скобки, отключив его выполнение смело кидайте на форму мемо, в конце кода так же на время добавьте строчку
Код:
...
Memo1.Lines.Assign(fl);
...
и посмотрите что будет отображаться в текстовом поле.

Наводка:

Флаг FOF_FILESONLY для операций только с файлами, прямой перевод (правда действует это условие лишь если в поле pFrom прописано в пути *.*)

pTo похоже на pFrom, содержит путь к целевой директории
в которую производится перемещение файлов, может содержать несколько путей, при этом нужно установить флаг FOF_MULTIDESTFILES.

Если задать ещё флаг FOF_WANTMAPPINGHANDLE то после выполнения файловых операций в структуре hNameMappings можно просмотреть что было сделано с файлами на самом деле

Текущую директорию можно установить с помощью функции SetCurrentDirectory и получить функцией GetCurrentDirectory

Для перемещения из "корневой" (для данной папки) директории вложенных папок следует в начале ставить в пути к ним двойной обратный слеш (\\)
Ответить с цитированием
Этот пользователь сказал Спасибо Alegun за это полезное сообщение:
Electronic_Arts (13.04.2014)
  #11  
Старый 13.04.2014, 04:31
Аватар для Electronic_Arts
Electronic_Arts Electronic_Arts вне форума
Местный
 
Регистрация: 13.07.2006
Адрес: на земле
Сообщения: 554
Версия Delphi: XE5
Репутация: 18
Восклицание

Я не хочу переходить по вложенным папкам так как мне достаточно есть папка то переносим

- Сделал как ты сказал - теперь в memo появляется путь к папке которая рядом с ехе-шником но после полета она не появляется в пункте назначения (но с пункта исчезает)

если код делить на две части то у меня не работает только вот эта часть
Код:
if fromDir=ExtractFiledir(ParamStr(0)) then //Если ЕХЕ-шник в той же папке которую хотим переместить то
   begin
    if FindFirst(fromDir + '\' + '*.*', faAnyFile, sr) = 0 then
      repeat
        if (sr.Name = '.') or (sr.name = '..') then Continue;
        if (sr.Attr and faDirectory) = faDirectory then
        //MoveDir(fromDir + sr.Name, toDir) если это не поменять на
          fl.Add(fromDir +'\'+ sr.Name) //то пустые папки в директории не перемещаются
            else
              if sr.Name <> ExtractFileName(ParamStr(0)) then fl.Add(fromDir +'\'+ sr.Name);
                until FindNext(sr) <> 0;
                  FindClose(sr);
 //Спросите тут почему не использовал POS
 //Просто чтоб избавить прогу от цикла
 s1:= ExtractFileDir(ParamStr(0));
 s2:= ExtractFilepath(ExtractFileDir(ParamStr(0)));
 delete(s1, 1, length(s2));
 ToS:=toDir+s1+'\';
После выполнения вижу в мемо
c:\SourceFolder\Новая папка

но на флешке
с:\SourceFolder
Новая папка - не появляется

Помоги как читать из hNameMappings старое и новое место положение перемешенных файлов в моем случае??...а то голова уже не варит...
__________________
Нет ничего не возможного. Вопрос только во времени...
Ответить с цитированием
  #12  
Старый 13.04.2014, 06:06
Аватар для Alegun
Alegun Alegun вне форума
LMD-DML
 
Регистрация: 12.07.2009
Адрес: Богородское
Сообщения: 3,025
Версия Delphi: D7E
Репутация: 1834
По умолчанию

На самом деле не всё так страшно, просто не надо было тупо вызов глушить, а сделать так
Код:
...
if (sr.Attr and faDirectory) <> 0 then
 begin
  fl.Add(fromDir + sr.Name);
  MoveDir(fromDir + sr.Name, toDir)
 end  else
   if sr.Name <> ExtractFileName(ParamStr(0)) then fl.Add(fromDir + sr.Name);
...

З.Ы. Опа какой пердюмонокль, отставить замену, только что заметил, извнт
Цитата:
Сообщение от Electronic_Arts
...После выполнения вижу в мемо
c:\SourceFolder\Новая папка

но на флешке
с:\SourceFolder
Новая папка - не появляется...
Этож API с его прикольной WIN-логикой: если папка пустая, то и нечего перемещать. Если вам всё равно пустышку требуется сдвинуть, тогда бороть "дружеский" интерфейс придется его же методами т.е. делать все как ткнуть ПКМаусом "копировать", потом "вставить" и "удалить", другими словами - сначало FO_COPY а затем FO_DELETE, хотя честно говоря смысла в этом усложнении не вижу. Можно ещё правда в такую папку предварительно какойнить мусор засунуть, типа как "папка.txt", тогда точно переместится, тоже вариант

Последний раз редактировалось Alegun, 13.04.2014 в 08:34.
Ответить с цитированием
Этот пользователь сказал Спасибо Alegun за это полезное сообщение:
Electronic_Arts (13.04.2014)
  #13  
Старый 13.04.2014, 15:57
Аватар для Electronic_Arts
Electronic_Arts Electronic_Arts вне форума
Местный
 
Регистрация: 13.07.2006
Адрес: на земле
Сообщения: 554
Версия Delphi: XE5
Репутация: 18
Восклицание

wFunc := FO_MOVE;
вынул из константы и решил еще 2 проблемы - остался только проблема с перемещением одной пустой папки
Просто если бы это была тупо проблема в WINAPI то почему если я рядом создам еще одну папку "Новая папка (2)" то несмотря на то что они пустые то они перемешаются оба??
__________________
Нет ничего не возможного. Вопрос только во времени...
Ответить с цитированием
  #14  
Старый 13.04.2014, 17:27
Аватар для Electronic_Arts
Electronic_Arts Electronic_Arts вне форума
Местный
 
Регистрация: 13.07.2006
Адрес: на земле
Сообщения: 554
Версия Delphi: XE5
Репутация: 18
Восклицание

Теперь такая фигня если рядом с ЕХЕ-шником просто создать Текстовый документ

http://i7.picsplace.ru/images/130414...c6e5323d8f.png

А если рядом еще и пустая папка то папка перемешается
а текстовый документ впихивается в какую то папку с названием "КА"

Вот сама программа глянь плиз что в нем происходит почему она так себя ведет
http://sendfile.su/967348
__________________
Нет ничего не возможного. Вопрос только во времени...

Последний раз редактировалось Electronic_Arts, 13.04.2014 в 22:14.
Ответить с цитированием
  #15  
Старый 13.04.2014, 23:21
Аватар для Electronic_Arts
Electronic_Arts Electronic_Arts вне форума
Местный
 
Регистрация: 13.07.2006
Адрес: на земле
Сообщения: 554
Версия Delphi: XE5
Репутация: 18
Восклицание

Выяснил проблема только с русскими названиями файлов...
но как решить??
__________________
Нет ничего не возможного. Вопрос только во времени...
Ответить с цитированием
Ответ



Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 19:42.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2021

ВКонтакте   Facebook   Twitter   Ссылка на Telegram