Changeset 21


Ignore:
Timestamp:
Apr 2, 2016, 11:12:47 PM (8 years ago)
Author:
chronos
Message:
  • Added: Suport for physical drive enumeration under Windows.
Location:
trunk
Files:
8 edited

Legend:

Unmodified
Added
Removed

  • trunk

    • Property svn:ignore

      •  

        old new  
        22lib
        33CoolDisk.lps
         4CoolDisk.exe

  • trunk/CoolDisk.lpi

    r15 r21  
    140140        <IsPartOfProject Value="True"/>
    141141        <ComponentName Value="Core"/>
     142        <HasResources Value="True"/>
    142143        <ResourceBaseClass Value="DataModule"/>
    143144      </Unit10>

  • trunk/Form/UFormMain.lfm

    r16 r21  
    11object FormMain: TFormMain
    2   Left = 442
    3   Height = 941
    4   Top = 366
    5   Width = 1703
     2  Left = -26
     3  Height = 925
     4  Top = 276
     5  Width = 1694
    66  Caption = 'CoolDisk'
    7   ClientHeight = 909
    8   ClientWidth = 1703
     7  ClientHeight = 0
     8  ClientWidth = 0
    99  Menu = MainMenu1
    1010  OnClose = FormClose
    … …  
    1313  OnDestroy = FormDestroy
    1414  OnShow = FormShow
    15   LCLVersion = '1.7'
     15  LCLVersion = '1.6.0.4'
    1616  object ToolBar1: TToolBar
    1717    Left = 0
    1818    Height = 26
    1919    Top = 0
    20     Width = 1703
     20    Width = 0
    2121    Caption = 'ToolBar1'
    2222    Images = Core.ImageList1
    … …  
    2828    end
    2929    object ToolButton2: TToolButton
    30       Left = 24
    31       Top = 2
     30      Left = 1
     31      Top = 24
    3232      Action = AScanStop
    3333    end
    3434    object ToolButton3: TToolButton
    35       Left = 47
    36       Top = 2
     35      Left = 1
     36      Top = 46
    3737      Action = AScanContinue
    3838    end
    3939  end
    4040  object Panel1: TPanel
    41     Left = 597
    42     Height = 883
    43     Top = 26
    44     Width = 1106
     41    Left = 0
     42    Height = 0
     43    Top = 0
     44    Width = 0
    4545    Align = alClient
    4646    BevelOuter = bvNone
    47     ClientHeight = 883
    48     ClientWidth = 1106
     47    ClientHeight = 0
     48    ClientWidth = 0
    4949    TabOrder = 1
    5050    object Image1: TImage
    51       Left = 8
    52       Height = 867
    53       Top = 8
    54       Width = 1090
     51      Left = 0
     52      Height = 0
     53      Top = 0
     54      Width = 0
    5555      Align = alClient
    5656      BorderSpacing.Around = 8
    … …  
    6060  object Panel2: TPanel
    6161    Left = 0
    62     Height = 883
    63     Top = 26
     62    Height = 0
     63    Top = 0
    6464    Width = 592
    6565    Align = alLeft
    6666    BevelOuter = bvNone
    67     ClientHeight = 883
     67    ClientHeight = 0
    6868    ClientWidth = 592
    6969    TabOrder = 2
    … …  
    7878    object Label1: TLabel
    7979      Left = 15
    80       Height = 24
     80      Height = 15
    8181      Top = 675
    82       Width = 101
     82      Width = 58
    8383      Caption = 'Sector size:'
    8484      ParentColor = False
    … …  
    8686    object LabelSectorSize: TLabel
    8787      Left = 256
    88       Height = 24
     88      Height = 15
    8989      Top = 675
    90       Width = 10
     90      Width = 6
    9191      Caption = '  '
    9292      ParentColor = False
    … …  
    9494    object LabelSectorCount: TLabel
    9595      Left = 256
    96       Height = 24
     96      Height = 15
    9797      Top = 704
    98       Width = 10
     98      Width = 6
    9999      Caption = '  '
    100100      ParentColor = False
    … …  
    102102    object Label2: TLabel
    103103      Left = 15
    104       Height = 24
     104      Height = 15
    105105      Top = 704
    106       Width = 119
     106      Width = 70
    107107      Caption = 'Sector count:'
    108108      ParentColor = False
    … …  
    110110    object LabelBlockCurrent: TLabel
    111111      Left = 256
    112       Height = 24
     112      Height = 15
    113113      Top = 736
    114       Width = 10
     114      Width = 6
    115115      Caption = '  '
    116116      ParentColor = False
    … …  
    118118    object Label3: TLabel
    119119      Left = 15
    120       Height = 24
     120      Height = 15
    121121      Top = 736
    122       Width = 136
     122      Width = 78
    123123      Caption = 'Current sector:'
    124124      ParentColor = False
    … …  
    126126    object Label4: TLabel
    127127      Left = 15
    128       Height = 24
     128      Height = 15
    129129      Top = 768
    130       Width = 162
     130      Width = 94
    131131      Caption = 'Damaged sectors:'
    132132      ParentColor = False
    … …  
    134134    object LabelBlockDamaged: TLabel
    135135      Left = 256
    136       Height = 24
     136      Height = 15
    137137      Top = 764
    138       Width = 10
     138      Width = 6
    139139      Caption = '  '
    140140      ParentColor = False
    … …  
    142142    object Label5: TLabel
    143143      Left = 15
    144       Height = 24
     144      Height = 15
    145145      Top = 796
    146       Width = 122
     146      Width = 70
    147147      Caption = 'Elapsed time:'
    148148      ParentColor = False
    … …  
    150150    object LabelElapsedTime: TLabel
    151151      Left = 256
    152       Height = 24
     152      Height = 15
    153153      Top = 792
    154       Width = 10
     154      Width = 6
    155155      Caption = '  '
    156156      ParentColor = False
    … …  
    158158    object Label6: TLabel
    159159      Left = 15
    160       Height = 24
     160      Height = 15
    161161      Top = 824
    162       Width = 142
     162      Width = 82
    163163      Caption = 'Estimated time:'
    164164      ParentColor = False
    … …  
    166166    object LabelEstimatedTime: TLabel
    167167      Left = 257
    168       Height = 24
     168      Height = 15
    169169      Top = 820
    170       Width = 10
     170      Width = 6
    171171      Caption = '  '
    172172      ParentColor = False
    … …  
    174174    object Label7: TLabel
    175175      Left = 15
    176       Height = 24
     176      Height = 15
    177177      Top = 644
    178       Width = 160
     178      Width = 93
    179179      Caption = 'Sectors per Block:'
    180180      ParentColor = False
    … …  
    182182    object LabelSectorPerBlock: TLabel
    183183      Left = 256
    184       Height = 24
     184      Height = 15
    185185      Top = 640
    186       Width = 10
     186      Width = 6
    187187      Caption = '  '
    188188      ParentColor = False
    … …  
    190190    object LabelIOSpeed: TLabel
    191191      Left = 256
    192       Height = 24
     192      Height = 15
    193193      Top = 848
    194       Width = 10
     194      Width = 6
    195195      Caption = '  '
    196196      ParentColor = False
    … …  
    198198    object Label8: TLabel
    199199      Left = 15
    200       Height = 24
     200      Height = 15
    201201      Top = 852
    202       Width = 94
     202      Width = 54
    203203      Caption = 'I/O speed:'
    204204      ParentColor = False
    … …  
    223223    object Label10: TLabel
    224224      Left = 15
    225       Height = 24
     225      Height = 15
    226226      Top = 612
    227       Width = 40
     227      Width = 23
    228228      Caption = 'Size:'
    229229      ParentColor = False
    … …  
    231231    object LabelSize: TLabel
    232232      Left = 256
    233       Height = 24
     233      Height = 15
    234234      Top = 608
    235       Width = 10
     235      Width = 6
    236236      Caption = '  '
    237237      ParentColor = False
    … …  
    283283    object Label11: TLabel
    284284      Left = 17
    285       Height = 24
     285      Height = 15
    286286      Top = 141
    287       Width = 107
     287      Width = 61
    288288      Caption = 'Operations:'
    289289      ParentColor = False
    … …  
    299299    object ComboBoxDrive: TComboBox
    300300      Left = 8
    301       Height = 38
     301      Height = 23
    302302      Top = 16
    303303      Width = 416
    304304      Anchors = [akTop, akLeft, akRight]
    305       ItemHeight = 0
     305      ItemHeight = 15
    306306      OnChange = ComboBoxDriveChange
    307307      Style = csDropDownList
    … …  
    326326  end
    327327  object Splitter1: TSplitter
    328     Left = 592
    329     Height = 883
    330     Top = 26
     328    Left = 0
     329    Height = 0
     330    Top = 0
    331331    Width = 5
    332332  end

  • trunk/Form/UFormMain.pas

    r20 r21  
    242242    DriveInfo.Assign(TDriveInfo(ComboBoxDrive.Items.Objects[ComboBoxDrive.ItemIndex]));
    243243    Modified := True;
    244     Core.Project.ScanProfile.SectorCount := DriveInfo.SectorCount;
    245     Core.Project.ScanProfile.SectorStart := 0;
    246     Core.Project.ScanProfile.SectorEnd := Core.Project.ScanProfile.SectorCount - 1;
     244    Core.Project.ScanProfile.LoadFromDriveInfo(DriveInfo);
    247245    UpdateInterface;
    248246    Redraw;
    … …  
    307305  ComboBoxDrive.ItemIndex := Core.DriveList.IndexOf(Core.DriveList.FindByModel(Core.Project.DriveInfo.Model));
    308306  if (ComboBoxDrive.ItemIndex = -1) and (ComboBoxDrive.Items.Count > 0) then ComboBoxDrive.ItemIndex := 0;
    309   ComboBoxDriveChange(Self);
     307  if ComboBoxDrive.ItemIndex <> -1 then
     308    Core.Project.DriveInfo.Assign(TDriveInfo(ComboBoxDrive.Items.Objects[ComboBoxDrive.ItemIndex]));
     309  Core.Project.ScanProfile.LoadFromDriveInfo(Core.Project.DriveInfo);
    310310
    311311  Redraw;

  • trunk/Form/UFormOperation.pas

    r19 r21  
    6161  ComboBoxRunMode.ItemIndex := Integer(DriveScan.Mode);
    6262  EditPattern.Text := '0x' + IntToHex(DriveScan.WritePattern, 2);
    63   SpinEditLastSector.MaxValue := DriveScan.SectorCount;
     63  SpinEditLastSector.MaxValue := DriveScan.SectorCount - 1;
    6464  SpinEditFirstSector.Value := DriveScan.SectorStart;
    6565  SpinEditLastSector.Value := DriveScan.SectorEnd;

  • trunk/UBlockMap.pas

    r18 r21  
    222222begin
    223223  ItemsCount := Point(Trunc(FDrawSize.X / BlockSize.X), Trunc(FDrawSize.Y / BlockSize.Y));
    224   FSectorPerBlock := Ceil(SectorCount / (ItemsCount.X * ItemsCount.Y));
     224  if (ItemsCount.X > 0) and (ItemsCount.Y > 0) then begin
     225    FSectorPerBlock := Ceil(SectorCount / (ItemsCount.X * ItemsCount.Y));
     226  end else FSectorPerBlock := 1;
     227  if FSectorPerBlock < 1 then FSectorPerBlock := 1;
    225228  SetBlockCount(Ceil(SectorCount / FSectorPerBlock));
    226229end;

  • trunk/UDriveScan.pas

    r19 r21  
    77uses
    88  Classes, SysUtils, Syncobjs, UBlockMap, Forms, DOM,
    9   UXMLUtils, Contnrs;
     9  UXMLUtils, Contnrs, UPhysDrive;
    1010
    1111type
    … …  
    2727  end;
    2828
     29  { TDriveScanProfile }
     30
    2931  TDriveScanProfile = class
    3032    SectorCount: Integer;
    … …  
    3335    Mode: TRunMode;
    3436    WritePattern: Byte;
     37    procedure LoadFromDriveInfo(DriveInfo: TDriveInfo);
    3538  end;
    3639
    … …  
    9497  SUnknownRunMode = 'Unknown run mode';
    9598
     99{ TDriveScanProfile }
     100
     101procedure TDriveScanProfile.LoadFromDriveInfo(DriveInfo: TDriveInfo);
     102begin
     103  SectorCount := DriveInfo.SectorCount;
     104  SectorStart := 0;
     105  SectorEnd := DriveInfo.SectorCount - 1;
     106end;
     107
    96108{ TDriveScanList }
    97109

  • trunk/UPhysDrive.pas

    r20 r21  
    66
    77uses
    8   Classes, SysUtils, Contnrs, UFindFile, UCommon;
     8  Classes, SysUtils, Contnrs, UFindFile, UCommon
     9  {$IFDEF Windows},ActiveX,ComObj,Variants
     10  {$ENDIF};
    911
    1012type
    … …  
    2931    procedure LoadToStrings(Strings: TStrings);
    3032    procedure Detect;
     33  private
     34    {$IFDEF Windows}
     35    procedure GetWin32DiskDriveInfo;
     36    {$ENDIF}
    3137  end;
    3238
    … …  
    109115  end;
    110116  {$ENDIF}
     117  {$IFDEF Windows}
     118  GetWin32DiskDriveInfo;
     119  {$ENDIF}
    111120  // Drive located using filename
    112121  NewDriveInfo := TDriveInfo.Create;
    … …  
    120129end;
    121130
     131{$IFDEF Windows}
     132procedure TDriveList.GetWin32DiskDriveInfo;
     133const
     134  WbemUser = '';
     135  WbemPassword = '';
     136  WbemComputer = 'localhost';
     137  wbemFlagForwardOnly = $00000020;
     138var
     139  FSWbemLocator: OLEVariant;
     140  FWMIService: OLEVariant;
     141  FWbemObjectSet: OLEVariant;
     142  FWbemObject: OLEVariant;
     143  oEnum: IEnumvariant;
     144  OutVar: LongWord;
     145  NewDriveInfo: TDriveInfo;
     146begin;
     147  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
     148  FWMIService := FSWbemLocator.ConnectServer(WbemComputer, 'root\CIMV2', WbemUser,
     149    WbemPassword);
     150  FWbemObjectSet := FWMIService.ExecQuery('SELECT * FROM Win32_DiskDrive',
     151    'WQL', wbemFlagForwardOnly);
     152  oEnum := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
     153  while oEnum.Next(1, FWbemObject, OutVar) = 0 do begin
     154    NewDriveInfo := TDriveInfo.Create;
     155    NewDriveInfo.Kind := dkPhysical;
     156    NewDriveInfo.Model := FWbemObject.Properties_.Item('Caption').Value;
     157    //NewDriveInfo.Model := FWbemObject.Properties_.Item('Model').Value;
     158    NewDriveInfo.Size := FWbemObject.Properties_.Item('Size').Value;
     159    NewDriveInfo.SectorSize := 4096;
     160    NewDriveInfo.SectorCount := NewDriveInfo.Size div NewDriveInfo.SectorSize;
     161    NewDriveInfo.Path := FWbemObject.Properties_.Item('DeviceID').Value;
     162    Add(NewDriveInfo);
     163
     164    FWbemObject := Unassigned;
     165  end;
     166end;
     167{$ENDIF}
     168
     169
    122170end.
    123171
Note: See TracChangeset for help on using the changeset viewer.