- Timestamp:
- Apr 2, 2016, 12:02:59 AM (9 years ago)
- Location:
- trunk
- Files:
-
- 9 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/CoolDisk.lpi
r8 r10 83 83 </Item5> 84 84 </RequiredPackages> 85 <Units Count=" 8">85 <Units Count="9"> 86 86 <Unit0> 87 87 <Filename Value="CoolDisk.lpr"/> … … 106 106 <IsPartOfProject Value="True"/> 107 107 <ComponentName Value="FormProject"/> 108 <HasResources Value="True"/> 108 109 <ResourceBaseClass Value="Form"/> 109 110 </Unit3> … … 124 125 <IsPartOfProject Value="True"/> 125 126 </Unit7> 127 <Unit8> 128 <Filename Value="Form/UFormOperation.pas"/> 129 <IsPartOfProject Value="True"/> 130 <ComponentName Value="FormOperation"/> 131 <ResourceBaseClass Value="Form"/> 132 </Unit8> 126 133 </Units> 127 134 </ProjectOptions> -
trunk/CoolDisk.lpr
r4 r10 9 9 Interfaces, // this includes the LCL widgetset 10 10 Forms, tachartlazaruspkg, UFormMain, UFormBenchmark, UFormProject, UProject, 11 UConfig, UBlockMap, UDriveScan, Common, TemplateGenerics 11 UConfig, UBlockMap, UDriveScan, Common, TemplateGenerics, UFormOperation 12 12 { you can add units after this }; 13 13 … … 20 20 Application.CreateForm(TFormBenchmark, FormBenchmark); 21 21 Application.CreateForm(TFormProject, FormProject); 22 Application.CreateForm(TFormOperation, FormOperation); 22 23 Application.Run; 23 24 end. -
trunk/UBlockMap.pas
r7 r10 182 182 TChange(FChanges[ChangeIndex + 1]).Index := Index + 1; 183 183 TChange(FChanges[ChangeIndex + 1]).Value := Change.Value; 184 if ChangeIndex = 0 then 184 if ChangeIndex = 0 then begin 185 TChange(FChanges[ChangeIndex]).Index := Index; 185 186 TChange(FChanges[ChangeIndex]).Value := AValue; 187 FChanges.Insert(ChangeIndex, TChange.Create); 188 TChange(FChanges[ChangeIndex]).Index := 0; 189 TChange(FChanges[ChangeIndex]).Value := bsNone; 190 end; 186 191 end else raise Exception.Create(SUnexpectedCombination); 187 192 end else raise Exception.Create(Format(SIndexOutOfRange, [Index])); … … 202 207 // Cut changes outside of max sector count 203 208 I := FChanges.Count - 1; 204 while TChange(FChanges[I]).Index >= FSectorCountdo Dec(I);205 if TChange(FChanges[I]).Index >= FSectorCountthen FChanges.Count := I;209 while (I >= 0) and (TChange(FChanges[I]).Index >= FSectorCount) do Dec(I); 210 if (I >= 0) and (TChange(FChanges[I]).Index >= FSectorCount) then FChanges.Count := I; 206 211 207 212 UpdateBlockSize; … … 330 335 I: Integer; 331 336 begin 332 WriteInteger(Node, 'SectorCount', SectorCount);333 334 337 NewNode := Node.OwnerDocument.CreateElement('Changes'); 335 338 Node.AppendChild(NewNode); … … 348 351 NewChange: TChange; 349 352 begin 350 SectorCount := ReadInteger(Node, 'SectorCount', 0);351 352 353 NewNode := Node.FindNode('Changes'); 353 354 if Assigned(NewNode) then begin -
trunk/UDriveScan.pas
r8 r10 25 25 TDriveScan = class 26 26 private 27 FDriveName: string; 27 28 FOnChange: TNotifyEvent; 28 29 FOnTerminate: TNotifyEvent; 30 FSectorCurrent: Integer; 29 31 ScanThread: TScanThread; 30 32 procedure DoChange; 31 33 procedure DoTerminate; 34 function GetSectorCount: Integer; 32 35 procedure Run; 36 procedure SetDriveName(AValue: string); 37 procedure SetSectorCount(AValue: Integer); 33 38 public 34 39 Lock: TCriticalSection; 35 40 BlockMap: TBlockMap; 36 41 SectorSize: Integer; 37 SectorCurrent: Integer;38 42 TimeStart: TDateTime; 39 43 TimeEnd: TDateTime; 40 44 Terminated: Boolean; 41 45 DamagedBlockCount: Integer; 42 Drive: string;43 46 Mode: TRunMode; 44 47 WritePattern: Byte; 48 SectorStart: Integer; 49 SectorEnd: Integer; 45 50 function GetElapsedTime: TDateTime; 51 procedure CheckDrive; 52 procedure Reset; 46 53 procedure Start; 47 54 procedure Stop; … … 50 57 procedure SaveToNode(Node: TDOMNode); 51 58 procedure LoadFromNode(Node: TDOMNode); 59 property SectorCurrent: Integer read FSectorCurrent; 60 property DriveName: string read FDriveName write SetDriveName; 52 61 property OnTerminate: TNotifyEvent read FOnTerminate write FOnTerminate; 53 62 property OnChange: TNotifyEvent read FOnChange write FOnChange; 63 property SectorCount: Integer read GetSectorCount write SetSectorCount; 54 64 end; 55 65 … … 114 124 procedure TDriveScan.DoTerminate; 115 125 begin 126 116 127 if Assigned(FOnTerminate) then FOnTerminate(Self); 128 end; 129 130 function TDriveScan.GetSectorCount: Integer; 131 begin 132 Result := BlockMap.SectorCount; 117 133 end; 118 134 … … 121 137 if TimeEnd <> 0 then Result := TimeEnd - TimeStart 122 138 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; 153 end; 154 155 procedure TDriveScan.Reset; 156 begin 157 TimeStart := Now; 158 DamagedBlockCount := 0; 159 BlockMap.Clear; 160 FSectorCurrent := SectorStart; 123 161 end; 124 162 … … 138 176 RealSize: Integer; 139 177 Buffer: array of Byte; 140 I: Integer;141 178 begin 142 179 try 143 180 Lock.Acquire; 144 TimeStart := Now;145 181 Terminated := False; 146 DamagedBlockCount := 0; 147 if Mode = rmRead then F := TFileStream.Create(Drive, fmOpenRead) 148 else if Mode = rmWrite then F := TFileStream.Create(Drive, fmOpenReadWrite); 149 BlockMap.SectorCount := F.Size div SectorSize; 150 BlockMap.Clear; 182 if Mode = rmRead then F := TFileStream.Create(DriveName, fmOpenRead) 183 else if Mode = rmWrite then F := TFileStream.Create(DriveName, fmOpenReadWrite); 184 try 151 185 SetLength(Buffer, SectorSize); 152 186 if Mode = rmWrite then 153 187 FillChar(Buffer[0], Length(Buffer), WritePattern); 154 for I := 0 to BlockMap.SectorCount - 1 do begin 155 SectorCurrent := I; 188 while FSectorCurrent < SectorEnd do begin 156 189 try 157 190 Lock.Release; … … 163 196 //Sleep(1); 164 197 end else begin 165 F.Position := I* SectorSize;198 F.Position := FSectorCurrent * SectorSize; 166 199 if Mode = rmRead then RealSize := F.Read(Buffer[0], SectorSize) 167 200 else if Mode = rmWrite then RealSize := F.Write(Buffer[0], SectorSize) … … 172 205 end; 173 206 if RealSize <> SectorSize then begin 174 BlockMap.Sectors[ I] := bsDamaged;207 BlockMap.Sectors[FSectorCurrent] := bsDamaged; 175 208 Inc(DamagedBlockCount); 176 end else BlockMap.Sectors[I] := bsOk; 209 end else BlockMap.Sectors[FSectorCurrent] := bsOk; 210 Inc(FSectorCurrent); 177 211 if Terminated then Break; 178 212 end; 179 F.Free; 180 213 finally 214 F.Free; 215 end; 181 216 finally 182 217 Lock.Release; … … 185 220 DoChange; 186 221 Terminated := True; 187 DoTerminate; 222 ScanThread.Synchronize(DoTerminate); 223 end; 224 225 procedure TDriveScan.SetDriveName(AValue: string); 226 begin 227 if FDriveName = AValue then Exit; 228 FDriveName := AValue; 229 CheckDrive; 230 end; 231 232 procedure TDriveScan.SetSectorCount(AValue: Integer); 233 begin 234 if BlockMap.SectorCount = AValue then Exit; 235 BlockMap.SectorCount := AValue; 188 236 end; 189 237 … … 204 252 SectorSize := 4096; 205 253 Terminated := True; 254 Reset; 206 255 end; 207 256 … … 221 270 WriteInteger(Node, 'DamagedBlockCount', DamagedBlockCount); 222 271 WriteInteger(Node, 'WritePattern', WritePattern); 223 WriteString(Node, 'DriveName', Drive );272 WriteString(Node, 'DriveName', DriveName); 224 273 WriteDateTime(Node, 'TimeStart', TimeStart); 225 274 WriteDateTime(Node, 'TimeEnd', TimeEnd); 275 WriteInteger(Node, 'SectorStart', SectorStart); 276 WriteInteger(Node, 'SectorEnd', SectorEnd); 277 WriteInteger(Node, 'SectorCurrent', FSectorCurrent); 226 278 227 279 NewNode := OwnerDocument.CreateElement('SectorMap'); … … 238 290 DamagedBlockCount := ReadInteger(Node, 'DamagedBlockCount', 0); 239 291 WritePattern := ReadInteger(Node, 'WritePattern', 0); 240 Drive := ReadString(Node, 'DriveName', '');292 DriveName := ReadString(Node, 'DriveName', ''); 241 293 TimeStart := ReadDateTime(Node, 'TimeStart', 0); 242 294 TimeEnd := ReadDateTime(Node, 'TimeEnd', 0); 295 FSectorCurrent := ReadInteger(Node, 'SectorCurrent', 0); 296 SectorStart := ReadInteger(Node, 'SectorStart', 0); 297 SectorEnd := ReadInteger(Node, 'SectorEnd', SectorCount - 1); 243 298 244 299 NewNode := FindNode('SectorMap'); -
trunk/UFormMain.lfm
r9 r10 13 13 OnShow = FormShow 14 14 LCLVersion = '1.7' 15 object ListView1: TListView16 Left = 1617 Height = 39018 Top = 13619 Width = 55220 Columns = <21 item22 end23 item24 Width = 48225 end>26 TabOrder = 027 end28 15 object ButtonScan: TButton 29 16 Left = 120 … … 32 19 Width = 75 33 20 Action = AScanStart 34 TabOrder = 121 TabOrder = 0 35 22 end 36 23 object Image1: TImage … … 175 162 Top = 56 176 163 Width = 93 177 Action = A ScanOptions178 TabOrder = 2164 Action = AProjectOptions 165 TabOrder = 1 179 166 end 180 167 object ButtonScan2: TButton … … 184 171 Width = 75 185 172 Action = AScanStop 186 TabOrder = 3173 TabOrder = 2 187 174 end 188 175 object Button1: TButton … … 192 179 Width = 91 193 180 Action = ABrowseDisk 194 TabOrder = 4181 TabOrder = 3 195 182 end 196 183 object EditDrive: TEdit … … 199 186 Top = 8 200 187 Width = 448 201 TabOrder = 5 202 end 203 object ComboBoxRunMode: TComboBox 204 Left = 17 205 Height = 34 206 Top = 88 207 Width = 247 208 ItemHeight = 0 209 ItemIndex = 0 210 Items.Strings = ( 211 'Read test' 212 'Write test' 213 ) 214 Style = csDropDownList 215 TabOrder = 6 216 Text = 'Read test' 217 end 218 object Label9: TLabel 219 Left = 286 220 Height = 24 221 Top = 95 222 Width = 121 223 Caption = 'Data pattern:' 224 ParentColor = False 225 end 226 object EditPattern: TEdit 227 Left = 440 228 Height = 34 229 Top = 88 230 Width = 80 231 TabOrder = 7 232 Text = '0xff' 188 TabOrder = 4 233 189 end 234 190 object Label10: TLabel … … 247 203 Caption = ' ' 248 204 ParentColor = False 205 end 206 object Button2: TButton 207 Left = 286 208 Height = 25 209 Top = 56 210 Width = 107 211 Action = AScanContinue 212 TabOrder = 5 213 end 214 object ListView1: TListView 215 Left = 17 216 Height = 414 217 Top = 168 218 Width = 567 219 Columns = < 220 item 221 Caption = 'Name' 222 end 223 item 224 Caption = 'Time start' 225 end 226 item 227 Caption = 'Time end' 228 end 229 item 230 Caption = 'First sector' 231 end 232 item 233 Caption = 'Last sector' 234 Width = 347 235 end> 236 OwnerData = True 237 ReadOnly = True 238 RowSelect = True 239 TabOrder = 6 240 ViewStyle = vsReport 241 OnData = ListView1Data 242 end 243 object Label11: TLabel 244 Left = 17 245 Height = 24 246 Top = 141 247 Width = 107 248 Caption = 'Operations:' 249 ParentColor = False 250 end 251 object Button3: TButton 252 Left = 16 253 Height = 25 254 Top = 96 255 Width = 187 256 Action = AOperationOptions 257 Caption = 'Options options' 258 TabOrder = 7 249 259 end 250 260 object Timer1: TTimer … … 265 275 OnExecute = AScanStopExecute 266 276 end 267 object A ScanOptions: TAction277 object AProjectOptions: TAction 268 278 Caption = 'Options' 269 OnExecute = A ScanOptionsExecute279 OnExecute = AProjectOptionsExecute 270 280 end 271 281 object ABrowseDisk: TAction … … 282 292 end 283 293 object AFileOpen: TAction 284 Caption = 'Open '294 Caption = 'Open...' 285 295 OnExecute = AFileOpenExecute 286 296 end … … 289 299 OnExecute = AFileSaveExecute 290 300 end 301 object AScanContinue: TAction 302 Caption = 'Continue' 303 OnExecute = AScanContinueExecute 304 end 305 object AFileNew: TAction 306 Caption = 'New' 307 OnExecute = AFileNewExecute 308 end 309 object AFileClose: TAction 310 Caption = 'Close' 311 OnExecute = AFileCloseExecute 312 end 313 object AOperationOptions: TAction 314 Caption = 'Options' 315 OnExecute = AOperationOptionsExecute 316 end 291 317 end 292 318 object OpenDialog1: TOpenDialog … … 303 329 object MenuItem1: TMenuItem 304 330 Caption = 'File' 331 object MenuItem10: TMenuItem 332 Action = AFileNew 333 end 305 334 object MenuItem2: TMenuItem 306 335 Action = AFileOpen … … 311 340 object MenuItem3: TMenuItem 312 341 Action = AFileSaveAs 342 end 343 object MenuItem11: TMenuItem 344 Action = AFileClose 345 end 346 object MenuItem15: TMenuItem 347 Action = AProjectOptions 348 end 349 object MenuItem12: TMenuItem 350 Caption = '-' 313 351 end 314 352 object MenuItem4: TMenuItem … … 324 362 Action = AScanStop 325 363 end 364 object MenuItem13: TMenuItem 365 Action = AScanContinue 366 end 367 object MenuItem14: TMenuItem 368 Caption = '-' 369 end 326 370 object MenuItem8: TMenuItem 327 Action = A ScanOptions371 Action = AOperationOptions 328 372 end 329 373 end -
trunk/UFormMain.pas
r9 r10 15 15 TFormMain = class(TForm) 16 16 ABrowseDisk: TAction; 17 AOperationOptions: TAction; 18 AFileClose: TAction; 19 AFileNew: TAction; 20 AScanContinue: TAction; 17 21 AFileSave: TAction; 18 22 AFileOpen: TAction; 19 23 AFileSaveAs: TAction; 20 24 AExit: TAction; 21 A ScanOptions: TAction;25 AProjectOptions: TAction; 22 26 AScanStart: TAction; 23 27 AScanStop: TAction; 24 28 ActionList1: TActionList; 25 29 Button1: TButton; 30 Button2: TButton; 31 Button3: TButton; 26 32 ButtonScan: TButton; 27 33 ButtonScan1: TButton; 28 34 ButtonScan2: TButton; 29 ComboBoxRunMode: TComboBox;30 EditPattern: TEdit;31 35 EditDrive: TEdit; 32 36 Image1: TImage; 33 37 Label1: TLabel; 34 38 Label10: TLabel; 39 Label11: TLabel; 35 40 Label2: TLabel; 36 41 Label3: TLabel; … … 40 45 Label7: TLabel; 41 46 Label8: TLabel; 42 Label9: TLabel;43 47 LabelElapsedTime: TLabel; 44 48 LabelBlockSize: TLabel; … … 53 57 MainMenu1: TMainMenu; 54 58 MenuItem1: TMenuItem; 59 MenuItem10: TMenuItem; 60 MenuItem11: TMenuItem; 61 MenuItem12: TMenuItem; 62 MenuItem13: TMenuItem; 63 MenuItem14: TMenuItem; 64 MenuItem15: TMenuItem; 55 65 MenuItem2: TMenuItem; 56 66 MenuItem3: TMenuItem; … … 67 77 procedure ABrowseDiskExecute(Sender: TObject); 68 78 procedure AExitExecute(Sender: TObject); 79 procedure AFileCloseExecute(Sender: TObject); 80 procedure AFileNewExecute(Sender: TObject); 69 81 procedure AFileOpenExecute(Sender: TObject); 70 82 procedure AFileSaveAsExecute(Sender: TObject); 71 83 procedure AFileSaveExecute(Sender: TObject); 72 procedure AScanOptionsExecute(Sender: TObject); 84 procedure AOperationOptionsExecute(Sender: TObject); 85 procedure AProjectOptionsExecute(Sender: TObject); 86 procedure AScanContinueExecute(Sender: TObject); 73 87 procedure AScanStartExecute(Sender: TObject); 74 88 procedure AScanStopExecute(Sender: TObject); … … 78 92 procedure FormShow(Sender: TObject); 79 93 procedure Image1Resize(Sender: TObject); 94 procedure ListView1Data(Sender: TObject; Item: TListItem); 80 95 procedure Timer1Timer(Sender: TObject); 81 96 private … … 84 99 RedrawPending: Boolean; 85 100 LastProjectFileName: string; 101 procedure ReloadOperationList; 102 procedure CheckDrive; 86 103 procedure ProjectOpen(FileName: string); 87 104 procedure DriveScanChange(Sender: TObject); … … 107 124 108 125 uses 109 UFormProject ;126 UFormProject, UFormOperation; 110 127 111 128 resourcestring 112 129 SProjectModified = '(modified)'; 130 SNewProject = 'New project'; 131 SSelectDriveForScan = 'Select drive for scan'; 132 SOpenStoredProject = 'Open stored scan project'; 133 SSaveProject = 'Save scan project'; 134 SBytes = 'bytes'; 135 136 const 137 DefaultDriveName = '/dev/sda'; 113 138 114 139 { TFormMain } … … 120 145 ProjectOpen(LastProjectFileName) 121 146 else begin 147 AFileNew.Execute; 122 148 Redraw; 123 149 UpdateInterface; … … 130 156 end; 131 157 158 procedure TFormMain.ListView1Data(Sender: TObject; Item: TListItem); 159 begin 160 if (Item.Index >= 0) and (Item.Index < Project.Scans.Count) then 161 with TDriveScan(Project.Scans[Item.Index]) do begin 162 Item.Caption := IntToStr(Item.Index); 163 Item.SubItems.Add(DateTimeToStr(TimeStart)); 164 Item.SubItems.Add(DateTimeToStr(TimeEnd)); 165 Item.SubItems.Add(IntToStr(SectorStart)); 166 Item.SubItems.Add(IntToStr(SectorEnd)); 167 end; 168 end; 169 132 170 procedure TFormMain.FormCreate(Sender: TObject); 133 171 begin 134 172 PrefixMultiplier := TPrefixMultiplier.Create; 135 Project := TProject.Create; 136 Project.Scans.Add(TDriveScan.Create); 137 DriveScan := TDriveScan(Project.Scans[0]); 173 EditDrive.Text := DefaultDriveName; 174 XMLConfig1.Filename := 'config.xml'; 175 Project := nil; 176 end; 177 178 procedure TFormMain.AScanStopExecute(Sender: TObject); 179 begin 180 DriveScan.Stop; 181 UpdateInterface; 182 end; 183 184 procedure TFormMain.AScanStartExecute(Sender: TObject); 185 begin 186 LastBlockPos := 0; 187 DriveScan.DriveName := EditDrive.Text; 188 DriveScan.Reset; 189 DriveScan.SectorSize := Project.SectorSize; 138 190 DriveScan.OnChange := DriveScanChange; 139 191 DriveScan.OnTerminate := DriveScanTerminate; 140 EditDrive.Text := '/dev/sdb';141 XMLConfig1.Filename := 'config.xml';142 end;143 144 procedure TFormMain.AScanStopExecute(Sender: TObject);145 begin146 DriveScan.Stop;147 UpdateInterface;148 end;149 150 procedure TFormMain.AScanStartExecute(Sender: TObject);151 begin152 LastBlockPos := 0;153 DriveScan.Drive := EditDrive.Text;154 DriveScan.SectorSize := Project.SectorSize;155 DriveScan.Mode := TRunMode(ComboBoxRunMode.ItemIndex);156 DriveScan.WritePattern := StrToInt(EditPattern.Text);157 192 DriveScan.Start; 158 193 Project.Modified := True; … … 160 195 end; 161 196 162 procedure TFormMain.AScanOptionsExecute(Sender: TObject); 163 begin 197 procedure TFormMain.AProjectOptionsExecute(Sender: TObject); 198 begin 199 CheckDrive; 164 200 FormProject.Load(Project); 165 201 if FormProject.ShowModal = mrOk then begin 166 202 FormProject.Save(Project); 167 end; 203 Project.Modified := True; 204 UpdateInterface; 205 end; 206 end; 207 208 procedure TFormMain.AScanContinueExecute(Sender: TObject); 209 begin 210 DriveScan.Start; 211 Project.Modified := True; 212 UpdateInterface; 168 213 end; 169 214 170 215 procedure TFormMain.ABrowseDiskExecute(Sender: TObject); 171 216 begin 172 OpenDialog1.Title := 'Select drive for scan';217 OpenDialog1.Title := SSelectDriveForScan; 173 218 OpenDialog1.DefaultExt := ''; 174 219 OpenDialog1.FileName := EditDrive.Text; … … 182 227 end; 183 228 229 procedure TFormMain.AFileCloseExecute(Sender: TObject); 230 begin 231 DriveScan := nil; 232 FreeAndNil(Project); 233 UpdateInterface; 234 end; 235 236 procedure TFormMain.AFileNewExecute(Sender: TObject); 237 begin 238 AFileClose.Execute; 239 Project := TProject.Create; 240 Project.FileName := SNewProject; 241 Project.Modified := False; 242 Project.Scans.Add(TDriveScan.Create); 243 DriveScan := TDriveScan(Project.Scans[0]); 244 245 CheckDrive; 246 DriveScan.SectorStart := 0; 247 DriveScan.SectorEnd := DriveScan.SectorCount - 1; 248 DriveScan.Reset; 249 Redraw; 250 UpdateInterface; 251 end; 252 184 253 procedure TFormMain.AFileOpenExecute(Sender: TObject); 185 254 begin 186 OpenDialog1.Title := 'Open stored scan project';255 OpenDialog1.Title := SOpenStoredProject; 187 256 OpenDialog1.DefaultExt := '.cdp'; 257 if Assigned(Project) then 258 OpenDialog1.FileName := Project.FileName; 188 259 if OpenDialog1.Execute then begin 189 260 ProjectOpen(OpenDialog1.FileName); … … 193 264 procedure TFormMain.AFileSaveAsExecute(Sender: TObject); 194 265 begin 195 SaveDialog1.Title := 'Save scan project';266 SaveDialog1.Title := SSaveProject; 196 267 SaveDialog1.DefaultExt := '.cdp'; 268 SaveDialog1.FileName := Project.FileName; 197 269 if SaveDialog1.Execute then begin 198 270 Project.SaveToFile(SaveDialog1.FileName); 271 UpdateInterface; 199 272 end; 200 273 end; … … 204 277 if not FileExists(Project.FileName) then 205 278 AFileSaveAs.Execute 206 else Project.SaveToFile(Project.FileName); 279 else begin 280 Project.SaveToFile(Project.FileName); 281 UpdateInterface; 282 end; 283 end; 284 285 procedure TFormMain.AOperationOptionsExecute(Sender: TObject); 286 begin 287 FormOperation.Load(DriveScan); 288 if FormOperation.ShowModal = mrOk then begin 289 FormOperation.Save(DriveScan); 290 Project.Modified := True; 291 UpdateInterface; 292 end; 207 293 end; 208 294 209 295 procedure TFormMain.FormClose(Sender: TObject; var CloseAction: TCloseAction); 210 296 begin 297 AFileClose.Execute; 211 298 SaveConfig; 212 299 end; … … 215 302 begin 216 303 Timer1.Enabled := False; 217 FreeAndNil(Project);304 if Assigned(Project) then FreeAndNil(Project); 218 305 FreeAndNil(PrefixMultiplier); 219 306 end; … … 227 314 procedure TFormMain.DoDraw; 228 315 begin 316 if Assigned(Project) then begin 229 317 if RedrawPending then 230 318 with Image1 do begin … … 240 328 end; 241 329 LabelSize.Caption := PrefixMultiplier.Add(DriveScan.BlockMap.SectorCount * DriveScan.SectorSize, 242 BasePrefixMultipliers, 'bytes');330 BasePrefixMultipliers, SBytes); 243 331 LabelSectorPerBlock.Caption := IntToStr(DriveScan.BlockMap.SectorPerBlock); 244 LabelBlockSize.Caption := IntToStr(DriveScan.SectorSize) + ' bytes';332 LabelBlockSize.Caption := IntToStr(DriveScan.SectorSize) + ' ' + SBytes; 245 333 LabelBlockCount.Caption := IntToStr(DriveScan.BlockMap.SectorCount); 246 334 LabelBlockCurrent.Caption := IntToStr(DriveScan.SectorCurrent); … … 268 356 DriveScan.Lock.Release; 269 357 end; 358 end else 359 with Image1 do begin 360 if (Width <> Picture.Bitmap.Width) or (Height <> Picture.Bitmap.Height) then 361 Picture.Bitmap.SetSize(Width, Height); 362 with Picture.Bitmap.Canvas do begin 363 Brush.Style := bsSolid; 364 Brush.Color := clSilver; 365 FillRect(0, 0, Width, Height); 366 end; 367 end; 270 368 end; 271 369 … … 277 375 AScanStart.Enabled := DriveScan.Terminated = True; 278 376 AScanStop.Enabled := DriveScan.Terminated = False; 377 AScanContinue.Enabled := (DriveScan.Terminated = True) and (DriveScan.SectorCurrent > DriveScan.SectorStart) and 378 (DriveScan.SectorCurrent < DriveScan.SectorEnd); 279 379 end; 280 380 AFileSave.Enabled := Assigned(Project) and Project.Modified; 281 381 AFileSaveAs.Enabled := Assigned(Project); 382 AFileClose.Enabled := Assigned(Project); 383 ReloadOperationList; 282 384 283 385 Title := ''; … … 298 400 procedure TFormMain.LoadConfig; 299 401 begin 300 EditDrive.Text := XMLConfig1.GetValue('DriveName', '/dev/sda');402 EditDrive.Text := XMLConfig1.GetValue('DriveName', DefaultDriveName); 301 403 LastProjectFileName := XMLConfig1.GetValue('LastProjectFileName', ''); 302 404 end; … … 307 409 end; 308 410 411 procedure TFormMain.ReloadOperationList; 412 begin 413 if Assigned(Project) then begin 414 ListView1.Items.Count := Project.Scans.Count; 415 end else begin 416 ListView1.Items.Count := 0; 417 end; 418 ListView1.Refresh; 419 end; 420 421 procedure TFormMain.CheckDrive; 422 begin 423 DriveScan.CheckDrive; 424 Project.SectorCount := DriveScan.SectorCount; 425 end; 426 309 427 procedure TFormMain.ProjectOpen(FileName: string); 310 428 begin 429 AFileNew.Execute; 311 430 Project.LoadFromFile(FileName); 312 431 LastProjectFileName := FileName; -
trunk/UFormProject.lfm
r1 r10 4 4 Top = 492 5 5 Width = 461 6 Caption = ' FormProject'6 Caption = 'Project settings' 7 7 ClientHeight = 340 8 8 ClientWidth = 461 9 LCLVersion = '1. 6.0.4'9 LCLVersion = '1.7' 10 10 object SpinEditSectorSize: TSpinEdit 11 Left = 1 8411 Left = 192 12 12 Height = 34 13 Top = 1614 Width = 1 3813 Top = 56 14 Width = 101 15 15 MaxValue = 100000 16 16 MinValue = 1 … … 21 21 Left = 16 22 22 Height = 24 23 Top = 1623 Top = 64 24 24 Width = 101 25 25 Caption = 'Sector size:' … … 44 44 TabOrder = 2 45 45 end 46 object SpinEditFirstSector: TSpinEdit47 Left = 1 8446 object Edit1: TEdit 47 Left = 192 48 48 Height = 34 49 Top = 56 50 Width = 138 51 MaxValue = 100000 52 MinValue = 1 49 Top = 8 50 Width = 240 53 51 TabOrder = 3 54 Value = 152 Text = 'Edit1' 55 53 end 56 54 object Label2: TLabel 57 55 Left = 16 58 56 Height = 24 59 Top = 56 60 Width = 105 61 Caption = 'First sector:' 62 ParentColor = False 63 end 64 object SpinEditLastSector: TSpinEdit 65 Left = 184 66 Height = 34 67 Top = 96 68 Width = 138 69 MaxValue = 100000 70 MinValue = 1 71 TabOrder = 4 72 Value = 1 73 end 74 object Label3: TLabel 75 Left = 16 76 Height = 24 77 Top = 96 78 Width = 81 79 Caption = 'Last size:' 57 Top = 16 58 Width = 60 59 Caption = 'Name:' 80 60 ParentColor = False 81 61 end -
trunk/UFormProject.pas
r1 r10 16 16 Button1: TButton; 17 17 Button2: TButton; 18 Edit1: TEdit; 18 19 Label1: TLabel; 19 20 Label2: TLabel; 20 Label3: TLabel;21 21 SpinEditSectorSize: TSpinEdit; 22 SpinEditFirstSector: TSpinEdit;23 SpinEditLastSector: TSpinEdit;24 22 private 25 { private declarations }26 23 public 27 24 procedure Load(Project: TProject); … … 40 37 procedure TFormProject.Load(Project: TProject); 41 38 begin 39 Edit1.Text := Project.Name; 42 40 SpinEditSectorSize.Value := Project.SectorSize; 43 SpinEditFirstSector.Value := Project.FirstSector;44 SpinEditLastSector.Value := Project.LastSector;45 41 end; 46 42 47 43 procedure TFormProject.Save(Project: TProject); 48 44 begin 45 Project.Name := Edit1.Text; 49 46 Project.SectorSize := SpinEditSectorSize.Value; 50 Project.FirstSector := SpinEditFirstSector.Value;51 Project.LastSector := SpinEditLastSector.Value;52 47 end; 53 48 -
trunk/UProject.pas
r9 r10 15 15 Name: string; 16 16 FileName: string; 17 FirstSector: Integer;18 LastSector: Integer;19 17 SectorSize: Integer; 20 18 SectorCount: Integer; 21 19 Modified: Boolean; 22 20 Scans: TDriveScanList; 21 DriveName: string; 23 22 constructor Create; 24 23 destructor Destroy; override; … … 61 60 with RootNode do begin 62 61 WriteInteger(RootNode, 'SectorSize', SectorSize); 62 WriteInteger(RootNode, 'SectorCount', SectorCount); 63 WriteString(RootNode, 'DriveName', DriveName); 63 64 64 65 NewNode := OwnerDocument.CreateElement('Scans'); … … 89 90 with RootNode do begin 90 91 SectorSize := ReadInteger(RootNode, 'SectorSize', 4096); 92 SectorCount := ReadInteger(RootNode, 'SectorCount', 0); 93 DriveName := ReadString(RootNode, 'DriveName', ''); 91 94 92 95 NewNode := FindNode('Scans');
Note:
See TracChangeset
for help on using the changeset viewer.