Changeset 17


Ignore:
Timestamp:
Apr 2, 2016, 8:57:38 PM (9 years ago)
Author:
chronos
Message:
  • Added: Handling exceptions raised inside background thread.
Location:
trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • trunk/Form/UFormMain.pas

    r16 r17  
    225225begin
    226226  with Core.Project do
    227   if DriveInfo.Path <> TDriveInfo(ComboBoxDrive.Items.Objects[ComboBoxDrive.ItemIndex]).Path then begin
     227  if (ComboBoxDrive.ItemIndex <> -1) and (DriveInfo.Path <> TDriveInfo(ComboBoxDrive.Items.Objects[ComboBoxDrive.ItemIndex]).Path) then begin
    228228    DriveInfo.Assign(TDriveInfo(ComboBoxDrive.Items.Objects[ComboBoxDrive.ItemIndex]));
    229229    Modified := True;
  • trunk/UDriveScan.pas

    r16 r17  
    66
    77uses
    8   Classes, SysUtils, Syncobjs, UBlockMap, Forms, UConfig, DOM, XMLRead, XMLWrite,
     8  Classes, SysUtils, Syncobjs, UBlockMap, Forms, DOM,
    99  UXMLUtils, Contnrs;
    1010
     
    1313
    1414  TRunMode = (rmRead, rmWrite);
     15  TExceptionEvent = procedure (Sender: TObject; E: Exception) of object;
    1516
    1617  { TScanThread }
    1718
    1819  TScanThread = class(TThread)
     20  private
     21    FOnException: TExceptionEvent;
     22  public
    1923    Scan: TDriveScan;
     24    ExceptionText: string;
    2025    procedure Execute; override;
     26    property OnException: TExceptionEvent read FOnException write FOnException;
    2127  end;
    2228
     
    3036    FSectorCurrent: Integer;
    3137    ScanThread: TScanThread;
     38    LastExceptionMessage: string;
     39    procedure DoOnExceptionSync;
     40    procedure DoOnException(Sender: TObject; E: Exception);
    3241    procedure DoChange;
    3342    procedure DoTerminate;
     
    111120procedure TScanThread.Execute;
    112121begin
    113   Scan.Run;
     122  ExceptionText := '';
     123  try
     124    Scan.Run;
     125  except
     126    on E: Exception do
     127      if Assigned(FOnException) then FOnException(Self, E);
     128  end;
    114129end;
    115130
    116131{ TDriveScan }
     132
     133procedure TDriveScan.DoOnExceptionSync;
     134begin
     135  raise Exception.Create(LastExceptionMessage);
     136end;
     137
     138procedure TDriveScan.DoOnException(Sender: TObject; E: Exception);
     139begin
     140  LastExceptionMessage := E.Message;
     141  TThread(Sender).Synchronize(TThread(Sender), DoOnExceptionSync);
     142end;
    117143
    118144procedure TDriveScan.DoChange;
     
    151177    Terminated := False;
    152178    ScanThread := TScanThread.Create(True);
     179    ScanThread.OnException := DoOnException;
    153180    ScanThread.Scan := Self;
    154181    ScanThread.Start;
     
    163190begin
    164191  try
    165   Lock.Acquire;
    166   Terminated := False;
    167   if Mode = rmRead then F := TFileStream.Create(DriveName, fmOpenRead)
    168     else if Mode = rmWrite then F := TFileStream.Create(DriveName, fmOpenReadWrite);
    169   try
    170   SetLength(Buffer, SectorSize);
    171   if Mode = rmWrite then
    172     FillChar(Buffer[0], Length(Buffer), WritePattern);
    173   while FSectorCurrent < SectorEnd do begin
     192    Lock.Acquire;
     193    Terminated := False;
     194    if Mode = rmRead then F := TFileStream.Create(DriveName, fmOpenRead)
     195      else if Mode = rmWrite then F := TFileStream.Create(DriveName, fmOpenReadWrite);
    174196    try
    175       Lock.Release;
    176       DoChange;
    177       F.Position := FSectorCurrent * SectorSize;
    178       if Mode = rmRead then RealSize := F.Read(Buffer[0], SectorSize)
    179         else if Mode = rmWrite then RealSize := F.Write(Buffer[0], SectorSize)
    180         else raise Exception.Create(SUnknownRunMode);
     197      SetLength(Buffer, SectorSize);
     198      if Mode = rmWrite then
     199        FillChar(Buffer[0], Length(Buffer), WritePattern);
     200      while FSectorCurrent < SectorEnd do begin
     201        try
     202          Lock.Release;
     203          DoChange;
     204          F.Position := FSectorCurrent * SectorSize;
     205          if Mode = rmRead then RealSize := F.Read(Buffer[0], SectorSize)
     206            else if Mode = rmWrite then RealSize := F.Write(Buffer[0], SectorSize)
     207            else raise Exception.Create(SUnknownRunMode);
     208        finally
     209          Lock.Acquire;
     210        end;
     211        if RealSize <> SectorSize then begin
     212          BlockMap.Sectors[FSectorCurrent] := bsDamaged;
     213          Inc(DamagedBlockCount);
     214        end else BlockMap.Sectors[FSectorCurrent] := bsOk;
     215        Inc(FSectorCurrent);
     216        if Terminated then Break;
     217      end;
    181218    finally
    182       Lock.Acquire;
     219      F.Free;
    183220    end;
    184     if RealSize <> SectorSize then begin
    185       BlockMap.Sectors[FSectorCurrent] := bsDamaged;
    186       Inc(DamagedBlockCount);
    187     end else BlockMap.Sectors[FSectorCurrent] := bsOk;
    188     Inc(FSectorCurrent);
    189     if Terminated then Break;
    190   end;
    191   finally
    192     F.Free;
    193   end;
    194221  finally
    195222    Lock.Release;
Note: See TracChangeset for help on using the changeset viewer.