Форум программистов [Powered by Invision Power Board]

Код


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;

Код


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