Changeset 3 for trunk/UFormMain.pas


Ignore:
Timestamp:
Mar 26, 2016, 11:40:31 PM (8 years ago)
Author:
chronos
Message:
  • Modified: TDriveScan and TBlockMap moved to separate units.
  • Added: Show total drive size.
File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/UFormMain.pas

    r2 r3  
    77uses
    88  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
    9   Menus, ComCtrls, ExtCtrls, ActnList, Math, dateutils, syncobjs, UProject,
    10   UConfig;
     9  Menus, ComCtrls, ExtCtrls, ActnList, dateutils, syncobjs, UProject,
     10  UDriveScan;
    1111
    1212type
    13 
    14   TSectorState = (bsNone, bsOk, bsDamaged);
    15 
    16   { TBlockMap }
    17 
    18   TBlockMap = class
    19   private
    20     FBlockSize: TPoint;
    21     FDrawSize: TPoint;
    22     FSectorPerBlock: Integer;
    23     FSectors: array of TSectorState;
    24     FBlocks: array of TSectorState;
    25     function GetBlockCount: Integer;
    26     function GetSector(Index: Integer): TSectorState;
    27     function GetSectorCount: Integer;
    28     procedure SetBlockCount(AValue: Integer);
    29     procedure SetBlockSize(AValue: TPoint);
    30     procedure SetDrawSize(AValue: TPoint);
    31     procedure SetSector(Index: Integer; AValue: TSectorState);
    32     procedure SetSectorCount(AValue: Integer);
    33     procedure SetSectorPerBlock(AValue: Integer);
    34     procedure UpdateBlockSize;
    35     procedure UpdateBlocks;
    36   public
    37     ItemsCount: TPoint;
    38     function CombineSectors(From, Count: Integer): TSectorState;
    39     procedure Draw(Canvas: TCanvas);
    40     procedure Clear;
    41     constructor Create;
    42     property BlockSize: TPoint read FBlockSize write SetBlockSize;
    43     property DrawSize: TPoint read FDrawSize write SetDrawSize;
    44     property SectorPerBlock: Integer read FSectorPerBlock write SetSectorPerBlock;
    45     property SectorCount: Integer read GetSectorCount write SetSectorCount;
    46     property BlockCount: Integer read GetBlockCount;
    47     property Sectors[Index: Integer]: TSectorState read GetSector write SetSector;
    48   end;
    49 
    50   TRunMode = (rmRead, rmWrite);
    51 
    52   { TDriveScan }
    53 
    54   TDriveScan = class
    55   private
    56     FOnChange: TNotifyEvent;
    57     FOnTerminate: TNotifyEvent;
    58     procedure DoChange;
    59     procedure DoTerminate;
    60   public
    61     Lock: TCriticalSection;
    62     BlockMap: TBlockMap;
    63     SectorSize: Integer;
    64     SectorCurrent: Integer;
    65     TimeStart: TDateTime;
    66     TimeEnd: TDateTime;
    67     Terminated: Boolean;
    68     DamagedBlockCount: Integer;
    69     Drive: string;
    70     Mode: TRunMode;
    71     WritePattern: Byte;
    72     function GetElapsedTime: TDateTime;
    73     procedure Run;
    74     constructor Create;
    75     destructor Destroy; override;
    76     property OnTerminate: TNotifyEvent read FOnTerminate write FOnTerminate;
    77     property OnChange: TNotifyEvent read FOnChange write FOnChange;
    78   end;
    79 
    80   { TScanThread }
    81 
    82   TScanThread = class(TThread)
    83     Form: TForm;
    84     procedure Execute; override;
    85   end;
    86 
    8713  { TFormMain }
    8814
    … …  
    10228    Image1: TImage;
    10329    Label1: TLabel;
     30    Label10: TLabel;
    10431    Label2: TLabel;
    10532    Label3: TLabel;
    … …  
    11744    LabelEstimatedTime: TLabel;
    11845    LabelIOSpeed: TLabel;
     46    LabelSize: TLabel;
    11947    LabelSectorPerBlock: TLabel;
    12048    ListView1: TListView;
    … …  
    13462  private
    13563    LastBlockPos: Integer;
    136     DriveScan: TDriveScan;
    13764    ScanThread: TScanThread;
    13865    RedrawPending: Boolean;
    … …  
    14370    procedure UpdateInterface;
    14471  public
     72    DriveScan: TDriveScan;
    14573    Project: TProject;
    14674    procedure Detect;
    … …  
    15785uses
    15886  UFormProject;
    159 
    160 { TScanThread }
    161 
    162 procedure TScanThread.Execute;
    163 begin
    164   TFormMain(Form).DriveScan.Run;
    165 end;
    166 
    167 { TBlockMap }
    168 
    169 function TBlockMap.GetSectorCount: Integer;
    170 begin
    171   Result := Length(FSectors);
    172 end;
    173 
    174 procedure TBlockMap.SetBlockCount(AValue: Integer);
    175 begin
    176   SetLength(FBlocks, AValue);
    177 end;
    178 
    179 procedure TBlockMap.SetBlockSize(AValue: TPoint);
    180 begin
    181   if (FBlockSize.X = AValue.X) and (FBlockSize.Y = AValue.Y) then Exit;
    182   if (AValue.X = 0) or (AValue.Y = 0) then
    183     raise Exception.Create('BlockSize can''t be set to 0');
    184   FBlockSize := AValue;
    185 end;
    186 
    187 procedure TBlockMap.SetDrawSize(AValue: TPoint);
    188 begin
    189   if (FDrawSize.X = AValue.X) and (FDrawSize.Y = AValue.Y) then Exit;
    190   FDrawSize := AValue;
    191   UpdateBlockSize;
    192 end;
    193 
    194 function TBlockMap.GetSector(Index: Integer): TSectorState;
    195 begin
    196   Result := FSectors[Index];
    197 end;
    198 
    199 function TBlockMap.GetBlockCount: Integer;
    200 begin
    201   Result := Length(FBlocks);
    202 end;
    203 
    204 procedure TBlockMap.SetSector(Index: Integer; AValue: TSectorState);
    205 var
    206   BlockIndex: Integer;
    207 begin
    208   FSectors[Index] := AValue;
    209 
    210   // Update block
    211   BlockIndex := Index div FSectorPerBlock;
    212   if (AValue = bsDamaged) then FBlocks[BlockIndex] := bsDamaged
    213   else if (AValue = bsOk) and (FBlocks[BlockIndex] = bsNone) then
    214     FBlocks[BlockIndex] := bsOk;
    215 end;
    216 
    217 procedure TBlockMap.SetSectorCount(AValue: Integer);
    218 begin
    219   if Length(FSectors) = AValue then Exit;
    220   SetLength(FSectors, AValue);
    221   UpdateBlockSize;
    222 end;
    223 
    224 procedure TBlockMap.SetSectorPerBlock(AValue: Integer);
    225 begin
    226   if FSectorPerBlock = AValue then Exit;
    227   FSectorPerBlock := AValue;
    228   UpdateBlockSize;
    229 end;
    230 
    231 procedure TBlockMap.UpdateBlockSize;
    232 begin
    233   ItemsCount := Point(Trunc(FDrawSize.X / BlockSize.X), Trunc(FDrawSize.Y / BlockSize.Y));
    234   FSectorPerBlock := Ceil(SectorCount / (ItemsCount.X * ItemsCount.Y));
    235   SetBlockCount(Ceil(SectorCount / FSectorPerBlock));
    236   UpdateBlocks;
    237 end;
    238 
    239 procedure TBlockMap.UpdateBlocks;
    240 var
    241   I: Integer;
    242 begin
    243   for I := 0 to BlockCount - 1 do
    244     FBlocks[I] := CombineSectors(I * FSectorPerBlock, FSectorPerBlock);
    245 end;
    246 
    247 function TBlockMap.CombineSectors(From, Count: Integer): TSectorState;
    248 var
    249   I: Integer;
    250   UpTo: Integer;
    251 begin
    252   Result := bsNone;
    253   UpTo := From + Count - 1;
    254   if UpTo >= SectorCount then Upto := SectorCount - 1;
    255   for I := From to UpTo do begin
    256 
    257     if (Result = bsNone) and (Sectors[I] = bsOk) then Result := bsOk
    258     else if (Result = bsOk) and (Sectors[I] = bsDamaged) then Result := bsDamaged;
    259   end;
    260 end;
    261 
    262 procedure TBlockMap.Draw(Canvas: TCanvas);
    263 var
    264   I: Integer;
    265   Rect: TRect;
    266   BlockState: TSectorState;
    267 begin
    268   Canvas.Pen.Style := psSolid;
    269   Canvas.Pen.Color := clBlack;
    270   // Clean background
    271   Canvas.Brush.Style := bsSolid;
    272   Canvas.Brush.Color := clBlack;
    273   Canvas.FillRect(0, 0, Canvas.Width, Canvas.Height);
    274 
    275   DrawSize := Point(Canvas.Width, Canvas.Height);
    276   if SectorPerBlock >= 1 then begin
    277     for I := 0 to BlockCount - 1 do begin
    278       Rect := Bounds((I mod ItemsCount.X) * BlockSize.X,
    279         (I div ItemsCount.X) * BlockSize.Y, BlockSize.X - 1, BlockSize.Y - 1);
    280       BlockState := FBlocks[I];
    281       if BlockState = bsOk then Canvas.Brush.Color := clGreen
    282         else if BlockState = bsDamaged then Canvas.Brush.Color := clRed
    283         else Canvas.Brush.Color := clSilver;
    284       Canvas.FillRect(Rect);
    285       //Canvas.TextOut(Rect.Left, Rect.Top, IntToStr(I));
    286     end;
    287   end;
    288 end;
    289 
    290 procedure TBlockMap.Clear;
    291 var
    292   I: Integer;
    293 begin
    294   for I := 0 to SectorCount - 1 do
    295     FSectors[I] := bsNone;
    296 end;
    297 
    298 constructor TBlockMap.Create;
    299 begin
    300   FBlockSize := Point(12, 12);
    301   SectorPerBlock := 1;
    302 end;
    303 
    304 { TDriveScan }
    305 
    306 procedure TDriveScan.DoChange;
    307 begin
    308   if Assigned(FOnChange) then FOnChange(Self);
    309 end;
    310 
    311 procedure TDriveScan.DoTerminate;
    312 begin
    313   if Assigned(FOnTerminate) then FOnTerminate(Self);
    314 end;
    315 
    316 function TDriveScan.GetElapsedTime: TDateTime;
    317 begin
    318   if TimeEnd <> 0 then Result := TimeEnd - TimeStart
    319     else Result := Now - TimeStart;
    320 end;
    321 
    322 procedure TDriveScan.Run;
    323 var
    324   F: TFileStream;
    325   RealSize: Integer;
    326   Buffer: array of Byte;
    327   I: Integer;
    328 begin
    329   try
    330   Lock.Acquire;
    331   TimeStart := Now;
    332   Terminated := False;
    333   DamagedBlockCount := 0;
    334   if Mode = rmRead then F := TFileStream.Create(Drive, fmOpenRead)
    335     else if Mode = rmWrite then F := TFileStream.Create(Drive, fmOpenReadWrite);
    336   BlockMap.SectorCount := F.Size div SectorSize;
    337   BlockMap.Clear;
    338   SetLength(Buffer, SectorSize);
    339   if Mode = rmWrite then
    340     FillChar(Buffer[0], Length(Buffer), WritePattern);
    341   for I := 0 to BlockMap.SectorCount - 1 do begin
    342     SectorCurrent := I;
    343     try
    344       Lock.Release;
    345       DoChange;
    346 
    347       if ConfigTest then begin
    348         if Random < 0.000001 then RealSize := 0
    349           else RealSize := SectorSize;
    350         //Sleep(1);
    351       end else begin
    352         F.Position := I * SectorSize;
    353         if Mode = rmRead then RealSize := F.Read(Buffer[0], SectorSize)
    354           else if Mode = rmWrite then RealSize := F.Write(Buffer[0], SectorSize)
    355           else raise Exception.Create('Unknwon run mode');
    356       end;
    357     finally
    358       Lock.Acquire;
    359     end;
    360     if RealSize <> SectorSize then begin
    361       BlockMap.Sectors[I] := bsDamaged;
    362       Inc(DamagedBlockCount);
    363     end else BlockMap.Sectors[I] := bsOk;
    364     if Terminated then Break;
    365   end;
    366   F.Free;
    367 
    368   finally
    369     Lock.Release;
    370   end;
    371   TimeEnd := Now;
    372   DoChange;
    373   Terminated := True;
    374   DoTerminate;
    375 end;
    376 
    377 constructor TDriveScan.Create;
    378 begin
    379   Lock := TCriticalSection.Create;
    380   BlockMap := TBlockMap.Create;
    381   SectorSize := 4096;
    382   Terminated := True;
    383 end;
    384 
    385 destructor TDriveScan.Destroy;
    386 begin
    387   FreeAndNil(BlockMap);
    388   FreeAndNil(Lock);
    389   inherited Destroy;
    390 end;
    39187
    39288{ TFormMain }
    … …  
    411107  ScanThread.Form := Self;
    412108  Project := TProject.Create;
    413   EditDrive.Text := '/dev/sdb';
     109  EditDrive.Text := '/dev/sda';
    414110end;
    415111
    … …  
    482178        Picture.Bitmap.EndUpdate;
    483179      end;
     180      LabelSize.Caption := IntToStr(DriveScan.BlockMap.SectorCount * DriveScan.SectorSize) + ' bytes';
    484181      LabelSectorPerBlock.Caption := IntToStr(DriveScan.BlockMap.SectorPerBlock);
    485182      LabelBlockSize.Caption := IntToStr(DriveScan.SectorSize) + ' bytes';
Note: See TracChangeset for help on using the changeset viewer.