Вопросы Теги

Delphi быстрая копия файла

вы можете попробовать: Навигация | Связанный символ

16
задан Yarin Miran 13 January 2009 в 08:01
поделиться

5 ответов

Существует несколько опций.

  1. Вы могли назвать CopyFile, который использует окна API
    • CopyFileA, которые Вы могли назвать API, который проводник использует (окна api SHFileOperation ). Пример вызывания той функции может быть найден на SCIP.be
    • , который Вы могли записать своей собственной функции, которая использует буфер.

, Если Вы знаете вид файлов Ваша попытка скопировать, 3th метод будет обычно превосходить другие по характеристикам. Поскольку API окон более настраивается для полного лучшего случая (маленькие файлы, большие файлы, файлы по сети, файлы на медленных дисках). Можно настроить собственную функцию копии больше для установки потребностям.

Ниже моя собственная буферизированная функция копии (я разделил обратные вызовы GUI): 

procedure CustomFileCopy(const ASourceFileName, ADestinationFileName: TFileName);
const
  BufferSize = 1024; // 1KB blocks, change this to tune your speed
var
  Buffer : array of Byte;
  ASourceFile, ADestinationFile: THandle;
  FileSize: DWORD;
  BytesRead, BytesWritten, BytesWritten2: DWORD;
begin
  SetLength(Buffer, BufferSize);
  ASourceFile := OpenLongFileName(ASourceFileName, 0);
  if ASourceFile <> 0 then
  try
    FileSize := FileSeek(ASourceFile, 0, FILE_END);
    FileSeek(ASourceFile, 0, FILE_BEGIN);
    ADestinationFile :=  CreateLongFileName(ADestinationFileName, FILE_SHARE_READ);
    if ADestinationFile <> 0 then
    try
      while (FileSize - FileSeek(ASourceFile, 0, FILE_CURRENT)) >= BufferSize do
      begin
        if (not ReadFile(ASourceFile, Buffer[0], BufferSize, BytesRead, nil)) and (BytesRead = 0) then
         Continue;
        WriteFile(ADestinationFile, Buffer[0], BytesRead, BytesWritten, nil);
        if BytesWritten < BytesRead then
        begin
          WriteFile(ADestinationFile, Buffer[BytesWritten], BytesRead - BytesWritten, BytesWritten2, nil);
          if (BytesWritten2 + BytesWritten) < BytesRead then
            RaiseLastOSError;
        end;
      end;
      if FileSeek(ASourceFile, 0, FILE_CURRENT)  < FileSize then
      begin
        if (not ReadFile(ASourceFile, Buffer[0], FileSize - FileSeek(ASourceFile, 0, FILE_CURRENT), BytesRead, nil)) and (BytesRead = 0) then
         ReadFile(ASourceFile, Buffer[0], FileSize - FileSeek(ASourceFile, 0, FILE_CURRENT), BytesRead, nil);
        WriteFile(ADestinationFile, Buffer[0], BytesRead, BytesWritten, nil);
        if BytesWritten < BytesRead then
        begin
          WriteFile(ADestinationFile, Buffer[BytesWritten], BytesRead - BytesWritten, BytesWritten2, nil);
          if (BytesWritten2 + BytesWritten) < BytesRead then
            RaiseLastOSError;
        end;
      end;
    finally
      CloseHandle(ADestinationFile);
    end;
  finally
    CloseHandle(ASourceFile);
  end;
end;

Собственные функции: 

function OpenLongFileName(const ALongFileName: String; SharingMode: DWORD): THandle; overload;
begin
  if CompareMem(@(ALongFileName[1]), @('\\'[1]), 2) then
    { Allready an UNC path }
    Result := CreateFileW(PWideChar(WideString(ALongFileName)), GENERIC_READ, SharingMode, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
  else
    Result := CreateFileW(PWideChar(WideString('\\?\' + ALongFileName)), GENERIC_READ, SharingMode, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
end;
function OpenLongFileName(const ALongFileName: WideString; SharingMode: DWORD): THandle;  overload;
begin
  if CompareMem(@(WideCharToString(PWideChar(ALongFileName))[1]), @('\\'[1]), 2) then
    { Allready an UNC path }
    Result := CreateFileW(PWideChar(ALongFileName), GENERIC_READ, SharingMode, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
  else
    Result := CreateFileW(PWideChar('\\?\' + ALongFileName), GENERIC_READ, SharingMode, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
end;

function CreateLongFileName(const ALongFileName: String; SharingMode: DWORD): THandle; overload;
begin
  if CompareMem(@(ALongFileName[1]), @('\\'[1]), 2) then
    { Allready an UNC path }
    Result := CreateFileW(PWideChar(WideString(ALongFileName)), GENERIC_WRITE, SharingMode, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)
  else
    Result := CreateFileW(PWideChar(WideString('\\?\' + ALongFileName)), GENERIC_WRITE, SharingMode, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
end;
function CreateLongFileName(const ALongFileName: WideString; SharingMode: DWORD): THandle; overload;
begin
  if CompareMem(@(WideCharToString(PWideChar(ALongFileName))[1]), @('\\'[1]), 2) then
    { Allready an UNC path }
    Result := CreateFileW(PWideChar(ALongFileName), GENERIC_WRITE, SharingMode, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)
  else
    Result := CreateFileW(PWideChar('\\?\' + ALongFileName), GENERIC_WRITE, SharingMode, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
end;

код немного более длинен настолько необходимый, потому что я включал механизм повторной попытки для поддержки проблемы соединения Wi-Fi, которую я имел.

, Таким образом, эта часть 

    if BytesWritten < BytesRead then
    begin
      WriteFile(ADestinationFile, Buffer[BytesWritten], BytesRead - BytesWritten, BytesWritten2, nil);
      if (BytesWritten2 + BytesWritten) < BytesRead then
        RaiseLastOSError;
    end;

могла быть записана как [1 117] 

    if BytesWritten < BytesRead then
    begin
        RaiseLastOSError;
    end;
27
ответ дан 30 November 2019 в 16:37
поделиться

У Вас может быть Проводник, делают это для Вас через SHFileOperation () http://msdn.microsoft.com/en-us/library/bb762164 (По сравнению с 85) .aspx (пример кода, делающий его от Дельфи: http://delphi.icm.edu.pl/ftp/d20free/fileop11.zip )

3
ответ дан 30 November 2019 в 16:37
поделиться

Возможно, можно изучить Резервное копирование Cobian 8 (под кодовым названием Черной Луны) исходный код. Это - открытый исходный код, записанный в Дельфи.

http://www.educ.umu.se/~cobian/cobianbackup.htm

3
ответ дан 30 November 2019 в 16:37
поделиться

Вы могли бы попытаться непосредственно звонить Windows API function CopyFile

2
ответ дан 30 November 2019 в 16:37
поделиться

Или можно сделать это "грязный" путь... Я нашел некоторый старый код, который делает задание (не уверенный, если это быстро): 

procedure CopyFile(const FileName, DestName: string);
var
   CopyBuffer   : Pointer; { buffer for copying }
   BytesCopied  : Longint;
   Source, Dest : Integer; { handles }
   Destination  : TFileName; { holder for expanded destination name }

const
     ChunkSize  : Longint = 8192; { copy in 8K chunks }

begin
     Destination := DestName;
     GetMem(CopyBuffer, ChunkSize); { allocate the buffer }
     try
       Source := FileOpen(FileName, fmShareDenyWrite); { open source file }
       if Source < 0
          then raise EFOpenError.CreateFmt('Error: Can''t open file!', [FileName]);
       try
         Dest := FileCreate(Destination); { create output file; overwrite existing }
         if Dest < 0
            then raise EFCreateError.CreateFmt('Error: Can''t create file!', [Destination]);
         try
           repeat
             BytesCopied := FileRead(Source, CopyBuffer^, ChunkSize); { read chunk }
             if BytesCopied > 0  {if we read anything... }
                then FileWrite(Dest, CopyBuffer^, BytesCopied); { ...write chunk }
           until BytesCopied < ChunkSize; { until we run out of chunks }

         finally
           FileClose(Dest); { close the destination file }
         end;

       finally
         FileClose(Source); { close the source file }
       end;

     finally
       FreeMem(CopyBuffer, ChunkSize); { free the buffer }
     end;
end;
1
ответ дан 30 November 2019 в 16:37
поделиться
Другие вопросы по тегам:

Похожие вопросы: