Форум: "Система";
Поиск по всему сайту: delphimaster.net;
Текущий архив: 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, но, как правило, еще более низкого уровня. Опять же, меру знать надо, а то так и до машинного кода можно "опуститься". А вероятность бага... А с кем не бывает? На то и Мастера и этот форум(ы).

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






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




Наверх





Память: 0.74 MB
Время: 0.038 c
14-22321          Olgerd                2001-11-01 21:44  2002.01.08  
Серьёзный вопрос


3-21939           SAN                   2001-12-04 16:01  2002.01.08  
MSSQL


3-21985           Скалли                2001-12-06 15:26  2002.01.08  
Дата + время без секунд в DBGrid


4-22488           Arick                 2001-10-31 09:20  2002.01.08  
как узнать имя загруженной Dll


14-22344          anod                  2001-11-06 13:15  2002.01.08  
Крестоики - нолики