VPF::Копирование директори - Форум программистов

Serhik_z

Дата 18.3.2006, 19:21 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Awaiting Authorisation
Сообщений: 108
Регистрация: 4.12.2004

Репутация: нет
Всего: нет

Здравствуйте!
Как можно добавить в код копирование директории
С CD-Rom:/001/dir ... на ... диск C:/dir
Либо заменить копирование файла, на директорию с файлами.

Код


function GetCDRoms: string; // Возвращает строку - список CD-ROM'ов
var
  d: dword;
  b: byte;
begin
  result := '';
  d := GetLogicalDrives;
  for b := 0 to 31 do
    if d and (1 shl b) > 0 then
      if GetDriveType(PChar(chr(b+65)+':\')) = DRIVE_CDROM then
        result := result + chr(b+65);
end;

function GetCDExist: string; // Возвращает список CD-ROM в которых есть диск
var
  i: integer;
  buf: array[0..MAX_PATH] of char;
  d:  dword;
begin
  result := GetCDRoms;
  SetErrorMode(SEM_FAILCRITICALERRORS);
  for i := Length(result) downto 1 do
    if not GetVolumeInformation(PChar(result[i] + ':\'), @buf, MAX_PATH,
                                nil, d, d, @buf, MAX_PATH) then
      Delete(result, i, 1);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  i: integer;
  s: string;
begin
 // ShowMessage(GetCDExist); // Показать строку со списком CD-ROM с диском внутри
 s := GetCDExist;
 for i := 1 to Length(s) do
 CopyFile(PChar(s[i] + ':\File.txt'), 'C:\File.txt', false);
end;

Это сообщение отредактировал(а) Serhik_z - 18.3.2006, 19:22

Guedda

Дата 18.3.2006, 19:26 (ссылка)

(нет голосов)

Загрузка ...

Подрывник

Профиль
Группа: Завсегдатай
Сообщений: 3137
Регистрация: 27.12.2005
Где: Ростов-на-Дону

Репутация: 14
Всего: 78

Вот тебе функция:

Код


function FullDirectoryCopy(SourceDir, TargetDir: string; StopIfNotAllCopied,
  OverWriteFiles: Boolean): Boolean;
var
  SR: TSearchRec;
  I: Integer;
begin
  Result := False;
  SourceDir := IncludeTrailingBackslash(SourceDir);
  TargetDir := IncludeTrailingBackslash(TargetDir);
  if not DirectoryExists(SourceDir) then
    Exit;
  if not ForceDirectories(TargetDir) then
    Exit;

  I := FindFirst(SourceDir + '*', faAnyFile, SR);
  try
    while I = 0 do
    begin
      if (SR.Name <> '') and (SR.Name <> '.') and (SR.Name <> '..') then
      begin
        if SR.Attr = faDirectory then
          Result := FullDirectoryCopy(SourceDir + SR.Name, TargetDir + SR.NAME,
            StopIfNotAllCopied, OverWriteFiles)
        else if not (not OverWriteFiles and FileExists(TargetDir + SR.Name))
          then
          Result := CopyFile(Pchar(SourceDir + SR.Name), Pchar(TargetDir +
            SR.Name), False)
        else
          Result := True;
        if not Result and StopIfNotAllCopied then
          exit;
      end;
      I := FindNext(SR);
    end;
  finally
    SysUtils.FindClose(SR);
  end;
end;

А вот пример использования:

Код


FullDirectoryCopy('C:\a', 'D:\b');
// Скопирует содержимое директории C:\a (не не саму директорию) в директорию D:\b

--------------------

Ll 2

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Общие вопросы \| Следующая тема »