Класс

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

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

Класс

Сообщение novo » 29.06.2012 22:50:34

Добрый день)

Решил научится писать классы, за одно облегчить себе жизнь, класс копирования файлов, да вот проблема с возобновлением остановленной процедуры.

Выдает ошибку после вызова процедуры возобновления ResumeCopy: "Проект project1.exe вызвал класс исключения 'External: SIGSEGV'"
После выдает ошибку отладчика.

Помогите разобраться где косяк)


Код: Выделить всё
TOnProgress = procedure(Sender:TObject;AllProgr,FileProgr:integer) of object;
   TOnError =    procedure(Sender:TObject;Error:string) of object;
   TOnDefault =  procedure(Sender:TObject) of object;
   TPauseRec =   record
                 FileIndex:integer;
                 ForIndex:integer;
                 StreamPosition:int64;
                 end;

   TMyCopyFiles=   class(TObject)
     private
      CopyFlag:    integer; //0-копирование 1-пауза 2-стоп 3- возобновить
      FPauseRec:   TPauseRec;
      FileList:    TstringList;
      aCopyToPath: string;
      FOnProgress: TOnProgress;
      FOnStart:    TOnDefault;
      FOnResume:   TOnDefault;
      FOnPause:    TOnDefault;
      FOnStop:     TOnDefault;
      FOnError:    TOnError;
      FStatus:     string;
      Procedure    Copy;
     public
     Constructor Create;
     Destructor  Destroy; override;

     procedure  AddFileName(value: string);
     Procedure  StartCopy;
     procedure  PauseCopy;
     procedure  ResumeCopy;
     Procedure  StopCopy;
     Procedure  Clear;

     property CopyToPath: string      read aCopyToPath write aCopyToPath;
     property OnProgress: TOnProgress read FOnProgress write FOnProgress;
     property Files:      TstringList read FileList    write FileList;
     ///События
     property OnStart:  TOnDefault  read  FOnStart  write FOnStart;
     property OnPause:  TOnDefault  read  FOnPause  write FOnPause;
     property OnStop:   TOnDefault  read  FOnStop   write FOnStop;
     property OnResume: TOnDefault  read  FOnResume write FOnResume;
     property OnError:  TOnError    read  FOnError  write FOnError;

     function Status:string;

   end;



var
  Form1: TForm1;
  MyCopyFiles:TMyCopyFiles;

implementation

{ TMyCopyFiles }

procedure TMyCopyFiles.Copy;
var
FromFileStream:TFileStream;
ToFileStream:TFileStream;
i,j,FilePosition,ForPosition:integer;
InitSize,BufferSize,SummData:int64;
FileCount:Integer;
t:integer;
begin
try
if Assigned(FOnStart) then  FOnStart(self);
FileCount:= Filelist.Count;
t:=0;
if CopyFlag=3 then FilePosition:=FPauseRec.FileIndex else FilePosition:=0;
for i:=FilePosition to FileCount-1 do begin
FromFileStream:=TFileStream.Create(Filelist.Strings[i],fmOpenRead);
ToFileStream:=TFileStream.Create(aCopyToPath+'\'+extractfilename(Filelist.Strings[i]),fmCreate or fmOpenWrite );
try
FromFileStream.Seek(0,soFromBeginning);
ToFileStream.Seek(0,soFromBeginning);
InitSize :=FromFileStream.Size;
BufferSize:=InitSize div 100;
SummData:=0;
if CopyFlag=3 then begin
ForPosition:=FPauseRec.ForIndex;
FromFileStream.Position:=FPauseRec.StreamPosition;
ToFileStream.Position:=FPauseRec.StreamPosition;
SummData:=FPauseRec.StreamPosition;
CopyFlag:=0;
end
else ForPosition:=0;

for j:=ForPosition to 99 do begin
if j=99 then BufferSize:=BufferSize+(InitSize-(BufferSize*100));
SummData:=SummData+ToFileStream.CopyFrom(FromFileStream,BufferSize);
     inc(t);
  case CopyFlag of
  1: begin  // пауза
  FPauseRec.FileIndex:=i;
  FPauseRec.ForIndex:=j;
  FPauseRec.StreamPosition:=SummData;
  exit;
     end;
  2: exit;
  end;
  if Assigned(FOnProgress) then  FOnProgress(self,(t*100) div (FileCount*100),j+1);
end;
finally
  FreeAndNil(FromFileStream);
  FreeAndNil(ToFileStream);
end;
end;
except
  on E : Exception do
  if Assigned(FOnError) then FOnError(self,'Ошибка '+E.Message);
end;
end;

constructor TMyCopyFiles.Create;
begin
  inherited;
FileList:=TStringList.Create;
end;

destructor TMyCopyFiles.Destroy;
begin
FileList.Free;
  inherited Destroy;
end;

procedure TMyCopyFiles.AddFileName(value: string);
begin
if length(value)>0 then FileList.Add(value);
end;

procedure TMyCopyFiles.StartCopy;
begin
FStatus:='copy';
if CopyFlag=1 then CopyFlag:=3 else CopyFlag:=0;
Copy;
end;

procedure TMyCopyFiles.PauseCopy;
begin
  FStatus:='pause';
CopyFlag:=1;
if Assigned(FOnPause) then FOnPause(self);
end;

procedure TMyCopyFiles.ResumeCopy;
begin
FStatus:='resume';
CopyFlag:=3;
if Assigned(FOnResume) then FOnResume(self);
Copy;
end;

procedure TMyCopyFiles.StopCopy;
begin
FStatus:='stop';
CopyFlag:=2;
if Assigned(FOnStop) then FOnStop(self);
end;

procedure TMyCopyFiles.Clear;
begin
  FileList.Clear;
end;

function TMyCopyFiles.Status: string;
begin
result:=FStatus;
end;
novo
новенький
 
Сообщения: 43
Зарегистрирован: 31.07.2011 21:35:10

Re: Класс

Сообщение Vadim » 30.06.2012 05:59:33

novo писал(а):вызвал класс исключения 'External: SIGSEGV'"

Эта ошибка типична, когда Вы обращаетесь к объекту, которого ещё нет или которого уже нет. Проверьте, какая билиберда хранится у Вас в FOnResume.
Vadim
долгожитель
 
Сообщения: 4112
Зарегистрирован: 05.10.2006 08:52:59
Откуда: Красноярск


Вернуться в Lazarus

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

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

Рейтинг@Mail.ru