Копирование файлов/папок

Вопросы программирования и использования среды Lazarus.

Модератор: Модераторы

Копирование файлов/папок

Сообщение Gorjatschew » 16.03.2008 12:30:20

Здравствуйте!
Подскажите пожалуйста, как в Lazarus (или как вариант в fpc) организовать копирование файлов и папок.
В хэлпе по делфи они все описаны, но, как я понял, там идёт привязка к WinApi, а в линухе это не хорошо :) вот и спрашиваю.
Если кто сможет ткнуть в примеры по лазарусу --- тоже буду благодарен.
Аватара пользователя
Gorjatschew
новенький
 
Сообщения: 23
Зарегистрирован: 15.01.2008 18:57:06
Откуда: Санкт-Петербург

Сообщение B4rr4cuda » 16.03.2008 17:54:48

sysutils:
Function CreateDir (Const NewDir : String) : Boolean;
Function RemoveDir (Const Dir : String) : Boolean;
Function ForceDirectories(Const Dir: string): Boolean;
Function DeleteFile (Const FileName : String) : Boolean;
Function RenameFile (Const OldName, NewName : String) : Boolean;
Function FileExists (Const FileName : String) : Boolean;
Function DirectoryExists (Const Directory : String) : Boolean;
Function FindFirst (Const Path : String; Attr : Longint; out Rslt : TSearchRec) : Longint;
Function FindNext (Var Rslt : TSearchRec) : Longint;
и тд

Найти алгоритм рекурсивного обхода дерева папок (используя FindFirst и FindNext) не составит труда. На том же delphiworld.narod.ru можно посмотреть. На лазаре та же метода , что и в делфи.
Аватара пользователя
B4rr4cuda
энтузиаст
 
Сообщения: 693
Зарегистрирован: 28.12.2007 07:48:35

Сообщение Gorjatschew » 17.03.2008 10:15:03

Спасибо за подсказку, нашёл много всего полезного.
Ещё такой вопрос:
Пример на копирование использует модули:
Код: Выделить всё
SysUtils, Classes, Consts;

Так фпц ругается на отсутствие Consts.
Код: Выделить всё
Fatal: Can't find unit Consts used by Program
Fatal: Compilation aborted

Чем его можно заменить?
Аватара пользователя
Gorjatschew
новенький
 
Сообщения: 23
Зарегистрирован: 15.01.2008 18:57:06
Откуда: Санкт-Петербург

Сообщение B4rr4cuda » 17.03.2008 11:10:06

Его можно закомментировать и разбираться уже с отдельными непонятками.
Откуда был взят пример?
Аватара пользователя
B4rr4cuda
энтузиаст
 
Сообщения: 693
Зарегистрирован: 28.12.2007 07:48:35

Сообщение Gorjatschew » 17.03.2008 20:06:47

Пример был из дельфей, из хэлпа. Если его заменить на CRT, ругается поменьше, теперь только две команды не находит:
Код: Выделить всё
copy.pp(37,46) Error: Identifier not found "SFOpenError"
copy.pp(41,52) Error: Identifier not found "SFCreateError"

В Дельфях компилется всё без проблем.
Аватара пользователя
Gorjatschew
новенький
 
Сообщения: 23
Зарегистрирован: 15.01.2008 18:57:06
Откуда: Санкт-Петербург

Сообщение Gorjatschew » 17.03.2008 20:08:54

Чтобы не быть голословным, приведу ещё и код процедуры:
Код: Выделить всё
uses
  SysUtils, Classes, Consts;

function HasAttr(const FileName: string; Attr: Word): Boolean;
var
  FileAttr: Integer;

begin
  FileAttr := FileGetAttr(FileName);
  if FileAttr = -1 then FileAttr := 0;
    Result := (FileAttr and Attr) = Attr;
end;

procedure CopyFile(const FileName, DestName: String);
var
  CopyBuffer: Pointer;
  BytesCopied: Longint;
  Source, Dest: Integer;
  Len: Integer;
  Destination: TFileName;
const
  ChunkSize: Longint = 8192;
begin
  Destination:=ExpandFileName(DestName);
  if HasAttr(Destination, faDirectory) then
  begin
    Len:=Length(Destination);
    if Destination[Len]='\' then
      Destination:=Destination+ExtractFileName(FileName)
    else
      Destination:=Destination+'\'+ExtractFileName(Filename);
  end;
  GetMem(CopyBuffer, ChunkSize);
  try
    Source:=FileOpen(FileName, fmShareDenyWrite);
    if Source<0 then
      raise EFOpenError.CreateFmt(SFOpenError, [FileName]);
    try
      Dest:=FileCreate(Destination);
      if Dest<0 then
        raise EFCreateError.CreateFmt(SFCreateError, [Destination]);
      try
        repeat
          BytesCopied:=Fileread(Source, CopyBuffer^, ChunkSize);
          if BytesCopied>0 then
            FileWrite(Dest, CopyBuffer^, BytesCopied);
        until BytesCopied<ChunkSize;
      finally
        FileClose(Dest);
      end;
    finally
      FileClose(Source);
    end;
  finally
    FreeMem(CopyBuffer, ChunkSize);
  end;
end;
Аватара пользователя
Gorjatschew
новенький
 
Сообщения: 23
Зарегистрирован: 15.01.2008 18:57:06
Откуда: Санкт-Петербург

Сообщение B4rr4cuda » 17.03.2008 20:48:16

Код: Выделить всё
unit unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs;

type
  TForm1 = class(TForm)
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation


function HasAttr(const FileName: string; Attr: Word): Boolean;
var
  FileAttr: Integer;

begin
  FileAttr := FileGetAttr(FileName);
  if FileAttr = -1 then FileAttr := 0;
    Result := (FileAttr and Attr) = Attr;
end;

procedure CopyFile(const FileName, DestName: String);
var
  CopyBuffer: Pointer;
  BytesCopied: Longint;
  Source, Dest: Integer;
  Len: Integer;
  Destination: TFileName;
const
  ChunkSize: Longint = 8192;
begin
  Destination:=ExpandFileName(DestName);
  if HasAttr(Destination, faDirectory) then
  begin
    Len:=Length(Destination);
    if Destination[Len]='\' then
      Destination:=Destination+ExtractFileName(FileName)
    else
      Destination:=Destination+'\'+ExtractFileName(Filename);
  end;
  GetMem(CopyBuffer, ChunkSize);
  try
    Source:=FileOpen(FileName, fmShareDenyWrite);
    if Source<0 then
      raise EFOpenError.CreateFmt('', [FileName]);
    try
      Dest:=FileCreate(Destination);
      if Dest<0 then
        raise EFCreateError.CreateFmt('', [Destination]);
      try
        repeat
          BytesCopied:=Fileread(Source, CopyBuffer^, ChunkSize);
          if BytesCopied>0 then
            FileWrite(Dest, CopyBuffer^, BytesCopied);
        until BytesCopied<ChunkSize;
      finally
        FileClose(Dest);
      end;
    finally
      FileClose(Source);
    end;
  finally
    FreeMem(CopyBuffer, ChunkSize);
  end;
end;

initialization
  {$I unit1.lrs}
end.


Этот код на лазаре тоже компилится без проблем. Вместо "SFOpenError" и "SFCreateError" просто пишем строку сообщения об ошибке.
Аватара пользователя
B4rr4cuda
энтузиаст
 
Сообщения: 693
Зарегистрирован: 28.12.2007 07:48:35

Сообщение B4rr4cuda » 17.03.2008 20:57:32

Да, кстати, этот модуль можно выдрать из дистриба делфи и кинуть в папку проекта. :)
Теряется лицензионная чистота, но не все ли равно, если прога пишется только для обучения? :)
Аватара пользователя
B4rr4cuda
энтузиаст
 
Сообщения: 693
Зарегистрирован: 28.12.2007 07:48:35

Сообщение Gorjatschew » 17.03.2008 22:00:04

Спасибо всем, кто помог!
Вариант с копирование модуля прекрасно работает, вариант, предложенный B4rr4cuda, тоже работает без проблем.

Ещё раз всем спасибо! Если что --- буду мучить ещё :)
Аватара пользователя
Gorjatschew
новенький
 
Сообщения: 23
Зарегистрирован: 15.01.2008 18:57:06
Откуда: Санкт-Петербург

Сообщение B4rr4cuda » 17.03.2008 23:11:29

Впервые обо мне говорят во множественном числе :lol:.
Аватара пользователя
B4rr4cuda
энтузиаст
 
Сообщения: 693
Зарегистрирован: 28.12.2007 07:48:35

Сообщение Gorjatschew » 18.03.2008 21:15:16

B4rr4cuda писал(а):Впервые обо мне говорят во множественном числе Laughing.

Опс, не заметил.
Значит мучать буду всех форумчан, а тов. B4rr4cuda отдельное спаисбо :)
Аватара пользователя
Gorjatschew
новенький
 
Сообщения: 23
Зарегистрирован: 15.01.2008 18:57:06
Откуда: Санкт-Петербург

Сообщение B4rr4cuda » 19.03.2008 00:11:36

Не за что. Рад помочь. :)
Аватара пользователя
B4rr4cuda
энтузиаст
 
Сообщения: 693
Зарегистрирован: 28.12.2007 07:48:35


Вернуться в Lazarus

Кто сейчас на конференции

Сейчас этот форум просматривают: Google [Bot] и гости: 14

Рейтинг@Mail.ru
cron