Альтернатива копированию файлов

[kisloid222]

Доброго времени суток, возник вопрос. Требуется найти альтернативу копирования файла, то есть процедуры CopyFile.
Надумал только одно, создать файл путем AssigenFile и скопировать содержимое файла который нужно скопировать в переменную как обычный текстовый файл и вставить в созданный (путем AssigenFile ) файл, но сохранить с тем же расширением который и был начально взятый файл.
Как правильно написать?


P.S. Прошу даже Не спрашивайте зачем такое извращение)))

[Serge_Bliznykov]

AssignFile + BlockRead/BlockWrite - это "классика"! Пример копирования был в хелпе на BlockRead() Turbo Pascal'я.

Но в современной Delphi рекомендую использовать TFileStream


Нескромный вопрос - а чем не устроила функция из WinAPI?

[Человек_Борща]

Нескромный вопрос - а чем не устроила функция из WinAPI?

....и делает она тоже самое...

[Аватар]

OFFTOP

Видимо нужно копирование сопровождать красочными звуковыми и цветовыми эффектами. По концу шоу монитор разлетается вдребезги, клавиатура подпрыгивает вверх на пол-метра, мышь убегает вместе с ковриком. Занавес

До делу - прогрессбар захотелось прицепить?

[SLAUR]

Procedure fmR;  begin FileMode:=0 end;
Procedure fmRW; begin FileMode:=2 end;

Function MyCreateDir(Dir:String):Boolean;
Var I,L:Integer;
    CurDir:String;
begin
  IF ExcludeTrailingBackslash(Dir) = '' then exit;
  Dir := IncludeTrailingBackslash(Dir);
  L:=Length(Dir);
  FOR I:=1 TO L do
  begin
    CurDir := CurDir + Dir[I];
    IF Dir[I] = '\' then
    begin
      IF not DirectoryExists(CurDir) then
        IF Not CreateDir(CurDir) then Exit;
    end;
  end;
  Result := True;
end;




Function CopyFil(fIn,fOut:String):boolean;
var F1,F2:file ; p:pointer ; w:integer ;
const BufCopyF=32000;
procedure ErrCop;
   begin
    {$I-}Close(F2){$I+};if IOResult<>0 then;
    {$I-}Close(F1){$I+};if IOResult<>0 then;
    {$I-}Erase(F2){$I+};if IOResult<>0 then;
   end;
begin
Result:=False;
if not Fileexists(fIn) then Exit;
if fIn=fOut then EXIT;
MyCreateDir(ExtractFilePath(fout));
FileSetAttr(fOut,0);
fmR;
Assign(F1,fIn);{$I-}Reset(F1,1); {$I+}
if IOResult<>0 then EXIT;
fmRW;
Assign(F2,fOut);{$I-}Rewrite(F2,1);{$I+}
if IOResult<>0 then
if FileExists(fOut) then
begin {$I-}Rewrite(F2,1);{$I+} if IOResult<>0 then EXIT;
end else EXIT;
GetMem(p,BufCopyF);
While not Eof(f1) do
begin
{$I-}BlockRead(f1,p^,BufCopyF,w);{$I+}if IOResult<>0 then begin ErrCop ;EXIT;end;
{$I-}BlockWrite(f2,p^,w);{$I+}if IOResult<>0 then begin ErrCop;EXIT;end;
end;
FreeMem(p,BufCopyF);
{$I-}FileSetDate(TFileRec(f2).Handle,
         FileGetDate(TFileRec(f1).Handle)); {$I+};if IOResult<>0 then EXIT;
{$I-}Close(f2){$I+};if IOResult<>0 then EXIT;
{$I-}Close(f1){$I+};if IOResult<>0 then EXIT;
CopyFil:=True;
end;