
15.06.2010, 17:05
|
Активный
|
|
Регистрация: 15.04.2009
Сообщения: 369
Репутация: 93
|
|
Несколько возможных вариантов (попадались в разные времена в разных местах).
Код:
function CopyFile0(fnFrom,fnTo : String): Boolean;
Const
RecS = 32768;
Var
Ok99 : Boolean;
F1,F2 : file;
NumRead, NumWritten: Integer;
Buf : array[1..RecS] of byte;
i : word;
begin
Result:=FALSE;
fnFrom:=Trim(fnFrom);
fnTo:=Trim(fnTo);
if (length(fnFrom)>0) and (length(fnTo)>0) then begin
if AnsiUpperCase(fnFrom)<>AnsiUpperCase(fnTo) then begin
AssignFile(F1,fnFrom);
FileMode := 0;
{$I-} reset(F1,1) {$I+};
Ok99:=(IoResult=0);
TRY
if Ok99 then begin
TRY
AssignFile(F2,fnTo);
FileMode := 2;
rewrite(F2,1);
repeat
BlockRead(F1, Buf, SizeOf(Buf), NumRead);
BlockWrite(F2, Buf, NumRead, NumWritten);
until (NumRead = 0) or (NumWritten <> NumRead);
Result:=TRUE;
FINALLY
{$I-} CloseFile(F2) {$I+};
Ok99:=(IoResult=0);
END;
end;
FINALLY
{$I-} CloseFile(F1) {$I+};
Ok99:=(IoResult=0);
END;
end;
end;
end;
function CopyFile1(fnFrom, fnTo : String;NotRewrite : BOOLEAN): Boolean;
Var
Err : LongInt;
cFrom,cTo : array[0..1023] of Char;
begin
Result:=FALSE;
fnFrom:=trim(fnFrom);
fnTo:=trim(fnTo);
if (length(fnFrom)>0) and (length(fnTo)>0) then begin
if AnsiUpperCase(fnFrom)<>AnsiUpperCase(fnTo) then begin
StrPCopy(cFrom,fnFrom);
StrPCopy(cTo,fnTo);
if WinProcs.CopyFile(cFrom,cTo,NotRewrite) then begin
Result:=TRUE;
end
else begin
Err:=GetLastError;
end;
end;
end;
end;
function CopyFile2(fnFrom, DirTo : string) : boolean;
//Если каталога DirTo не существует, Windows выдаст запрос на его создание
var
F : TShFileOpStruct;
begin
Result:=false;
fnFrom:=Trim(fnFrom);
if length(fnFrom)>0 then begin
DirTo:=Trim(DirTo);
F.Wnd := 0;
F.wFunc := FO_COPY;
fnFrom:=fnFrom+#0;
F.pFrom:=pchar(fnFrom);
DirTo:=DirTo+#0;
F.pTo:=pchar(DirTo);
F.fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMATION;
Result:=ShFileOperation(F) = 0;
end;
end;
//Этот вариант был в режиме проверки.
//Не помню - довел его до ума или нет.
function CopyFile3(fnFrom, fnTo : string) : boolean;
var
FromFile, ToFile: File;
Ok99 : boolean;
begin
Result:=FALSE;
fnFrom:=Trim(fnFrom);
fnTo:=Trim(fnTo);
if (length(fnFrom)>0) and (length(fnTo)>0) then begin
if AnsiUpperCase(fnFrom)<>AnsiUpperCase(fnTo) then begin
AssignFile(FromFile, fnFrom);
AssignFile(ToFile, fnTo);
{$I-} Reset(FromFile) {$I+};
Ok99:=(IoResult=0);
try
Rewrite(ToFile);
try
if LZCopy(TFileRec(FromFile).Handle, TFileRec(ToFile).Handle)<0 then begin
//raise Exception.Create('Error using LZCopy');
end
else begin
Result:=TRUE;
end;
finally
{$I-} CloseFile(ToFile) {$I+};
Ok99:=(IoResult=0);
end;
finally
{$I-} CloseFile(FromFile) {$I+};
Ok99:=(IoResult=0);
end;
end;
end;
end;
|