Форум: "Система";
Текущий архив: 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.01 c