Форум: "Система";
Поиск по всему сайту: 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.03 c
14-22388          Merlin                2001-11-08 11:43  2002.01.08  
Очередная грязь в кладовке


4-22507           Slaviq                2001-11-06 17:55  2002.01.08  
Системные иконки


3-21980           Aleksandr             2001-12-05 13:26  2002.01.08  
Как в программе сформировать connection string TADOConnection?


1-22128           vinni2000             2001-12-18 17:17  2002.01.08  
RichEdit!!!!!!!!!!!!!!!!!


1-22133           Sand Worm             2001-12-19 14:55  2002.01.08  
Frame