Changeset 12


Ignore:
Timestamp:
Apr 2, 2016, 11:08:30 AM (8 years ago)
Author:
chronos
Message:
  • Added: Available block drives detection under Linux.
Location:
trunk
Files:
3 added
6 edited

Legend:

Unmodified
Added
Removed

  • trunk/CoolDisk.lpi

    r10 r12  
    8383      </Item5>
    8484    </RequiredPackages>
    85     <Units Count="9">
     85    <Units Count="11">
    8686      <Unit0>
    8787        <Filename Value="CoolDisk.lpr"/>
    … …  
    8989      </Unit0>
    9090      <Unit1>
    91         <Filename Value="UFormMain.pas"/>
    92         <IsPartOfProject Value="True"/>
    93         <ComponentName Value="FormMain"/>
    94         <HasResources Value="True"/>
    95         <ResourceBaseClass Value="Form"/>
    96       </Unit1>
    97       <Unit2>
    9891        <Filename Value="Form/UFormBenchmark.pas"/>
    9992        <IsPartOfProject Value="True"/>
    … …  
    10194        <HasResources Value="True"/>
    10295        <ResourceBaseClass Value="Form"/>
     96      </Unit1>
     97      <Unit2>
     98        <Filename Value="UProject.pas"/>
     99        <IsPartOfProject Value="True"/>
    103100      </Unit2>
    104101      <Unit3>
    105         <Filename Value="UFormProject.pas"/>
     102        <Filename Value="UConfig.pas"/>
     103        <IsPartOfProject Value="True"/>
     104      </Unit3>
     105      <Unit4>
     106        <Filename Value="UBlockMap.pas"/>
     107        <IsPartOfProject Value="True"/>
     108      </Unit4>
     109      <Unit5>
     110        <Filename Value="UDriveScan.pas"/>
     111        <IsPartOfProject Value="True"/>
     112      </Unit5>
     113      <Unit6>
     114        <Filename Value="Form/UFormOperation.pas"/>
     115        <IsPartOfProject Value="True"/>
     116        <ComponentName Value="FormOperation"/>
     117        <HasResources Value="True"/>
     118        <ResourceBaseClass Value="Form"/>
     119      </Unit6>
     120      <Unit7>
     121        <Filename Value="Form/UFormMain.pas"/>
     122        <IsPartOfProject Value="True"/>
     123        <ComponentName Value="FormMain"/>
     124        <HasResources Value="True"/>
     125        <ResourceBaseClass Value="Form"/>
     126      </Unit7>
     127      <Unit8>
     128        <Filename Value="Form/UFormProject.pas"/>
    106129        <IsPartOfProject Value="True"/>
    107130        <ComponentName Value="FormProject"/>
    108131        <HasResources Value="True"/>
    109132        <ResourceBaseClass Value="Form"/>
    110       </Unit3>
    111       <Unit4>
    112         <Filename Value="UProject.pas"/>
     133      </Unit8>
     134      <Unit9>
     135        <Filename Value="UPhysDrive.pas"/>
    113136        <IsPartOfProject Value="True"/>
    114       </Unit4>
    115       <Unit5>
    116         <Filename Value="UConfig.pas"/>
     137      </Unit9>
     138      <Unit10>
     139        <Filename Value="Form/UFormDrive.pas"/>
    117140        <IsPartOfProject Value="True"/>
    118       </Unit5>
    119       <Unit6>
    120         <Filename Value="UBlockMap.pas"/>
    121         <IsPartOfProject Value="True"/>
    122       </Unit6>
    123       <Unit7>
    124         <Filename Value="UDriveScan.pas"/>
    125         <IsPartOfProject Value="True"/>
    126       </Unit7>
    127       <Unit8>
    128         <Filename Value="Form/UFormOperation.pas"/>
    129         <IsPartOfProject Value="True"/>
    130         <ComponentName Value="FormOperation"/>
     141        <ComponentName Value="FormDrive"/>
    131142        <ResourceBaseClass Value="Form"/>
    132       </Unit8>
     143      </Unit10>
    133144    </Units>
    134145  </ProjectOptions>

  • trunk/CoolDisk.lpr

    r10 r12  
    88  {$ENDIF}
    99  Interfaces, // this includes the LCL widgetset
    10   Forms, tachartlazaruspkg, UFormMain, UFormBenchmark, UFormProject, UProject,
    11   UConfig, UBlockMap, UDriveScan, Common, TemplateGenerics, UFormOperation
     10  Forms, tachartlazaruspkg, UFormBenchmark, UProject,
     11  UConfig, UBlockMap, UDriveScan, Common, TemplateGenerics, UFormOperation,
     12  UFormProject, UFormMain, UPhysDrive, UFormDrive
    1213  { you can add units after this };
    1314
    … …  
    1920  Application.CreateForm(TFormMain, FormMain);
    2021  Application.CreateForm(TFormBenchmark, FormBenchmark);
     22  Application.CreateForm(TFormOperation, FormOperation);
    2123  Application.CreateForm(TFormProject, FormProject);
    22   Application.CreateForm(TFormOperation, FormOperation);
     24  Application.CreateForm(TFormDrive, FormDrive);
    2325  Application.Run;
    2426end.

  • trunk/Form/UFormMain.lfm

    r11 r12  
    173173    TabOrder = 2
    174174  end
    175   object Button1: TButton
    176     Left = 480
    177     Height = 25
    178     Top = 17
    179     Width = 91
    180     Action = ABrowseDisk
    181     TabOrder = 3
    182   end
    183   object EditDrive: TEdit
    184     Left = 16
    185     Height = 34
    186     Top = 8
    187     Width = 448
    188     TabOrder = 4
    189   end
    190175  object Label10: TLabel
    191176    Left = 16
    … …  
    210195    Width = 107
    211196    Action = AScanContinue
    212     TabOrder = 5
     197    TabOrder = 3
    213198  end
    214199  object ListView1: TListView
    … …  
    237222    ReadOnly = True
    238223    RowSelect = True
    239     TabOrder = 6
     224    TabOrder = 4
    240225    ViewStyle = vsReport
    241226    OnData = ListView1Data
    … …  
    256241    Action = AOperationOptions
    257242    Caption = 'Options options'
    258     TabOrder = 7
     243    TabOrder = 5
     244  end
     245  object ComboBoxDrive: TComboBox
     246    Left = 15
     247    Height = 38
     248    Top = 8
     249    Width = 464
     250    ItemHeight = 0
     251    OnChange = ComboBoxDriveChange
     252    Style = csDropDownList
     253    TabOrder = 6
    259254  end
    260255  object Timer1: TTimer
    … …  
    281276    object ABrowseDisk: TAction
    282277      Caption = 'Select...'
    283       OnExecute = ABrowseDiskExecute
    284278    end
    285279    object AExit: TAction

  • trunk/Form/UFormMain.pas

    r11 r12  
    88  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
    99  Menus, ComCtrls, ExtCtrls, ActnList, dateutils, syncobjs, UProject,
    10   UDriveScan, UPrefixMultiplier, XMLConf;
     10  UDriveScan, UPrefixMultiplier, XMLConf, UPhysDrive;
    1111
    1212type
    … …  
    2727    AScanStop: TAction;
    2828    ActionList1: TActionList;
    29     Button1: TButton;
    3029    Button2: TButton;
    3130    Button3: TButton;
    … …  
    3332    ButtonScan1: TButton;
    3433    ButtonScan2: TButton;
    35     EditDrive: TEdit;
     34    ComboBoxDrive: TComboBox;
    3635    Image1: TImage;
    3736    Label1: TLabel;
    … …  
    7574    Timer1: TTimer;
    7675    XMLConfig1: TXMLConfig;
    77     procedure ABrowseDiskExecute(Sender: TObject);
    7876    procedure AExitExecute(Sender: TObject);
    7977    procedure AFileCloseExecute(Sender: TObject);
    … …  
    8785    procedure AScanStartExecute(Sender: TObject);
    8886    procedure AScanStopExecute(Sender: TObject);
     87    procedure ComboBoxDriveChange(Sender: TObject);
    8988    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    9089    procedure FormCreate(Sender: TObject);
    … …  
    10099    LastProjectFileName: string;
    101100    procedure ReloadOperationList;
    102     procedure CheckDrive;
    103101    procedure ProjectOpen(FileName: string);
    104102    procedure DriveScanChange(Sender: TObject);
    … …  
    108106    procedure UpdateInterface;
    109107  public
     108    DriveList: TDriveList;
    110109    DriveScan: TDriveScan;
    111110    Project: TProject;
    … …  
    134133  SBytes = 'bytes';
    135134
    136 const
    137   DefaultDriveName = '/dev/sda';
    138 
    139135{ TFormMain }
    140136
    141137procedure TFormMain.FormShow(Sender: TObject);
    142138begin
     139  Detect;
    143140  LoadConfig;
    144141  if FileExists(LastProjectFileName) then
    … …  
    171168begin
    172169  PrefixMultiplier := TPrefixMultiplier.Create;
    173   EditDrive.Text := DefaultDriveName;
    174170  XMLConfig1.Filename := 'config.xml';
    175171  Project := nil;
     172  DriveList := TDriveList.Create;
    176173end;
    177174
    … …  
    182179end;
    183180
     181procedure TFormMain.ComboBoxDriveChange(Sender: TObject);
     182begin
     183  DriveScan.SectorCount := TDriveInfo(DriveList[ComboBoxDrive.ItemIndex]).SectorCount;
     184  DriveScan.DriveName := TDriveInfo(DriveList[ComboBoxDrive.ItemIndex]).Path;
     185  DriveScan.SectorStart := 0;
     186  DriveScan.SectorEnd := DriveScan.SectorCount - 1;
     187end;
     188
    184189procedure TFormMain.AScanStartExecute(Sender: TObject);
    185190begin
    186191  LastBlockPos := 0;
    187   DriveScan.DriveName := EditDrive.Text;
     192  DriveScan.DriveName := TDriveInfo(DriveList[ComboBoxDrive.ItemIndex]).Path;
    188193  DriveScan.Reset;
    189194  DriveScan.SectorSize := Project.SectorSize;
    … …  
    197202procedure TFormMain.AProjectOptionsExecute(Sender: TObject);
    198203begin
    199   CheckDrive;
    200204  FormProject.Load(Project);
    201205  if FormProject.ShowModal = mrOk then begin
    … …  
    211215  Project.Modified := True;
    212216  UpdateInterface;
    213 end;
    214 
    215 procedure TFormMain.ABrowseDiskExecute(Sender: TObject);
    216 begin
    217   OpenDialog1.Title := SSelectDriveForScan;
    218   OpenDialog1.DefaultExt := '';
    219   OpenDialog1.FileName := EditDrive.Text;
    220   if OpenDialog1.Execute then
    221     EditDrive.Text := OpenDialog1.FileName;
    222217end;
    223218
    … …  
    243238  DriveScan := TDriveScan(Project.Scans[0]);
    244239
    245   CheckDrive;
    246240  DriveScan.SectorStart := 0;
    247241  DriveScan.SectorEnd := DriveScan.SectorCount - 1;
    … …  
    304298  if Assigned(Project) then FreeAndNil(Project);
    305299  FreeAndNil(PrefixMultiplier);
     300  FreeAndNil(DriveList);
    306301end;
    307302
    … …  
    394389procedure TFormMain.SaveConfig;
    395390begin
    396   XMLConfig1.SetValue('DriveName', EditDrive.Text);
     391  XMLConfig1.SetValue('DriveName', TDriveInfo(DriveList[ComboBoxDrive.ItemIndex]).Model);
    397392  XMLConfig1.SetValue('LastProjectFileName', LastProjectFileName);
    398393end;
    … …  
    400395procedure TFormMain.LoadConfig;
    401396begin
    402   EditDrive.Text := XMLConfig1.GetValue('DriveName', DefaultDriveName);
     397  ComboBoxDrive.ItemIndex := DriveList.IndexOf(DriveList.FindByModel(XMLConfig1.GetValue('DriveName', '')));
    403398  LastProjectFileName := XMLConfig1.GetValue('LastProjectFileName', '');
    404399end;
    … …  
    419414end;
    420415
    421 procedure TFormMain.CheckDrive;
    422 begin
    423   DriveScan.CheckDrive;
    424   Project.SectorCount := DriveScan.SectorCount;
    425 end;
    426 
    427416procedure TFormMain.ProjectOpen(FileName: string);
    428417begin
    … …  
    445434
    446435procedure TFormMain.Detect;
    447 begin
    448 
     436var
     437  I: Integer;
     438begin
     439  DriveList.Detect;
     440  while ComboBoxDrive.Items.Count > DriveList.Count do
     441    ComboBoxDrive.Items.Delete(ComboBoxDrive.Items.Count - 1);
     442  while ComboBoxDrive.Items.Count < DriveList.Count do
     443    ComboBoxDrive.Items.Add('');
     444  for I := 0 to DriveList.Count - 1 do
     445    ComboBoxDrive.Items[I] := TDriveInfo(DriveList[I]).Model + ' (' +
     446      PrefixMultiplier.Add(TDriveInfo(DriveList[I]).Size, BasePrefixMultipliers, 'B') + ')';
    449447end;
    450448

  • trunk/Packages/Common/UCommon.pas

    r4 r12  
    6565procedure FreeThenNil(var Obj);
    6666function RemoveQuotes(Text: string): string;
     67function LoadFileToStr(const FileName: TFileName): AnsiString;
    6768
    6869
    … …  
    448449end;
    449450
     451function LoadFileToStr(const FileName: TFileName): AnsiString;
     452var
     453  FileStream: TFileStream;
     454  Read: Integer;
     455begin
     456  Result := '';
     457  FileStream := TFileStream.Create(FileName, fmOpenRead);
     458  try
     459    if FileStream.Size > 0 then begin
     460      SetLength(Result, FileStream.Size);
     461      Read := FileStream.Read(Pointer(Result)^, FileStream.Size);
     462      SetLength(Result, Read);
     463    end;
     464  finally
     465    FileStream.Free;
     466  end;
     467end;
    450468
    451469initialization

  • trunk/UDriveScan.pas

    r10 r12  
    4949    SectorEnd: Integer;
    5050    function GetElapsedTime: TDateTime;
    51     procedure CheckDrive;
    5251    procedure Reset;
    5352    procedure Start;
    … …  
    137136  if TimeEnd <> 0 then Result := TimeEnd - TimeStart
    138137    else Result := Now - TimeStart;
    139 end;
    140 
    141 procedure TDriveScan.CheckDrive;
    142 var
    143   F: TFileStream;
    144 begin
    145   if FileExists(DriveName) then begin
    146     F := TFileStream.Create(DriveName, fmOpenRead);
    147     try
    148       BlockMap.SectorCount := F.Size div SectorSize;
    149     finally
    150       F.Free;
    151     end;
    152   end else BlockMap.SectorCount := 0;
    153138end;
    154139
    … …  
    227212  if FDriveName = AValue then Exit;
    228213  FDriveName := AValue;
    229   CheckDrive;
    230214end;
    231215
Note: See TracChangeset for help on using the changeset viewer.