Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Система";
Текущий архив: 2002.01.08;
Скачать: [xml.tar.bz2];

Вниз

Как скопировать самого себя, если программа запущена   Найти похожие ветки 

 
VS   (2001-09-27 07:14) [0]

Как можно скопировать самого себя, если приложение уже запущено.
Т.е. переместить из одной папки в другую.


 
Digitman   (2001-09-27 08:55) [1]

Так "переместить" или "скопировать" ?

Копирование делается элементарно, поскольку не запрещено открывать исп.файл для чтения в момент, когда задача из него выполняется.

С перемещением гораздо сложнее из-за особенностей реализации Делфи. И возможно только в Win9x.


 
VS   (2001-09-27 14:09) [2]

Извиняюсь! Скопировать. Если можно примерчик.


 
Andrey Klimov   (2001-09-27 14:19) [3]

function NormalDir(const DirName: string): string;
begin
Result := DirName;
if (Result <> "") and
not (Result[Length(Result)] in [":", "\"]) then
begin
if (Length(Result) = 1) and (UpCase(Result[1]) in ["A".."Z"]) then
Result := Result + ":\"
else Result := Result + "\";
end;
end;

function HasAttr(const FileName: string; Attr: Integer): Boolean;
var
FileAttr: Integer;
begin
FileAttr := FileGetAttr(FileName);
Result := (FileAttr >= 0) and (FileAttr and Attr = Attr);
end;

function GetFileSize(const FileName: string): Int64;
var
Handle: THandle;
FindData: TWin32FindData;
begin
Handle := FindFirstFile(PChar(FileName), FindData);
if Handle <> INVALID_HANDLE_VALUE then begin
Windows.FindClose(Handle);
if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
begin
Int64Rec(Result).Lo := FindData.nFileSizeLow;
Int64Rec(Result).Hi := FindData.nFileSizeHigh;
Exit;
end;
end;
Result := -1;
end;

procedure CopyFileEx(const FileName, DestName: string; OverwriteReadOnly, ShellDialog: Boolean);
var
CopyBuffer: Pointer;
Source, Dest: Integer;
Destination: TFileName;
BytesCopied: Longint;
Attr: Integer;
const
ChunkSize: Longint = 8192;
begin
Destination := DestName;
if HasAttr(Destination, faDirectory) then
Destination := NormalDir(Destination) + ExtractFileName(FileName);
GetMem(CopyBuffer, ChunkSize);
try
Source := FileOpen(FileName, fmShareDenyWrite);
if Source < 0 then
raise EFOpenError.CreateFmt(ResStr(SFOpenError), [FileName]);
try
ForceDirectories(ExtractFilePath(Destination));
if OverwriteReadOnly then begin
Attr := FileGetAttr(Destination);
if (Attr >= 0) and ((Attr and faReadOnly) <> 0) then
FileSetAttr(Destination, Attr and not faReadOnly);
end;
Dest := FileCreate(Destination);
if Dest < 0 then
raise EFCreateError.CreateFmt(ResStr(SFCreateError), [Destination]);
try
repeat
BytesCopied := FileRead(Source, CopyBuffer^, ChunkSize);
if BytesCopied = -1 then
raise EReadError.Create(ResStr(SReadError));
if BytesCopied > 0 then begin
if FileWrite(Dest, CopyBuffer^, BytesCopied) = -1 then
raise EWriteError.Create(ResStr(SWriteError));
end;
until BytesCopied < ChunkSize;
FileSetDate(Dest, FileGetDate(Source));
finally
FileClose(Dest);
end;
finally
FileClose(Source);
end;
finally
FreeMem(CopyBuffer, ChunkSize);
end;
end;



 
Юрий Зотов   (2001-09-27 16:40) [4]

Ух-ты! Супер!

Но, кажется, велосипеды можно и не изобретать. Например:
CopyFile(PChar(ParamStr(0)), PChar("Новый_путь" + ExtractFileName(ParamStr(0))), True);

Или SHFileOperation (если нужно показать диалог).


 
Andrey Klimov   (2001-09-27 18:24) [5]

А еще можно вставить код для прорисовки какого ни будь прогрессбара...проирывания музыки и т.д. Не люблю черных ящиков. У меня с детства тяга "а что там внутри?"...:)


 
Юрий Зотов   (2001-09-27 18:54) [6]

> Andrey Klimov

Однако же, Вы противоречите сами себе. Вместо одной функции API в Вашем коде используется несколько, поэтому и "черных ящиков" в нем намного больше. И вероятность бага намного выше.

Прогрессбар рисует SHFileOperation, тоже без нашего участия. А музыку и т.д. можно крутить в параллельном потоке.

Win32 API оттестирован миллионами юзеров и программистов во всем мире. Стоит ли верить себе больше, чем Microsoft?


 
Andrey Klimov   (2001-09-27 20:30) [7]

Нет, не противоречу. В данном случае я не люблю черных ящиков "по теме", т.е. например, мне не нравится СТАНДАРТНЫЙ диалог копирования файлов, или мне не хочется использовать шелловский диалог форматирования дискет... Я в этом смысле. Конечно, в результате, вместо одной функции API могут быть порождены вызовы еще большего количества функций API, но, как правило, еще более низкого уровня. Опять же, меру знать надо, а то так и до машинного кода можно "опуститься". А вероятность бага... А с кем не бывает? На то и Мастера и этот форум(ы).

Верить себе?
Иногда стоит. Когда хочется "извратиться" (в плане интерфейса, например). Не буду спорить, и Вы правы. Однако, нам же удалось дать НЕСКОЛЬКО вариантов ответа? Был бы выбор, а вопрошающий пусть сам решает какой ответ использовать. Меня, например, бесит, когда на какой ни будь мой вопрос, дается всего один ответ (иногда и не отвечают вовсе), хотя я знаю, что должно быть больше вариантов, типа, делай так, потому что надо делать только так. А почему ТОЛЬКО так? Почему нельзя осветить альтернативные способы?






Страницы: 1 вся ветка

Форум: "Система";
Текущий архив: 2002.01.08;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.47 MB
Время: 0.008 c
1-22097
Сержик
2001-12-19 15:45
2002.01.08
К чему две кнопки привязать, чтобы они были внизу по центру?


1-22204
Dmitriy(new)
2001-12-13 19:37
2002.01.08
код не создает более `273 files in win2000


14-22385
модератор
2001-11-03 11:57
2002.01.08
>To Merlin - (SYSTRAY)


3-21993
&#1050;&#1085;&#1086;&#1087;&#1082;&#1072;
2001-12-07 09:23
2002.01.08
Поиск в базе данных (Очень срочно!!!)


1-22091
Mikhalyov Dmitry
2001-12-19 16:02
2002.01.08
вопрос из Pascal





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский