- Timestamp:
- Mar 30, 2016, 11:32:54 PM (9 years ago)
- Location:
- trunk
- Files:
-
- 5 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/UBlockMap.pas
r6 r7 6 6 7 7 uses 8 Classes, SysUtils, Graphics, Math, Contnrs, Dialogs; 8 Classes, SysUtils, Graphics, Math, Contnrs, Dialogs, DOM, XMLRead, XMLWrite, 9 UXMLUtils; 9 10 10 11 type … … 43 44 constructor Create; 44 45 destructor Destroy; override; 46 procedure SaveToNode(Node: TDOMNode); 47 procedure LoadFromNode(Node: TDOMNode); 45 48 property BlockSize: TPoint read FBlockSize write SetBlockSize; 46 49 property DrawSize: TPoint read FDrawSize write SetDrawSize; … … 321 324 end; 322 325 326 procedure TBlockMap.SaveToNode(Node: TDOMNode); 327 var 328 NewNode: TDOMNode; 329 NewNode2: TDOMNode; 330 I: Integer; 331 begin 332 WriteInteger(Node, 'SectorCount', SectorCount); 333 334 NewNode := Node.OwnerDocument.CreateElement('Changes'); 335 Node.AppendChild(NewNode); 336 for I := 0 to FChanges.Count - 1 do begin 337 NewNode2 := NewNode.OwnerDocument.CreateElement('Change'); 338 NewNode.AppendChild(NewNode2); 339 WriteInteger(NewNode2, 'Index', TChange(FChanges[I]).Index); 340 WriteInteger(NewNode2, 'Value', Integer(TChange(FChanges[I]).Value)); 341 end; 342 end; 343 344 procedure TBlockMap.LoadFromNode(Node: TDOMNode); 345 var 346 NewNode: TDOMNode; 347 NewNode2: TDOMNode; 348 NewChange: TChange; 349 begin 350 SectorCount := ReadInteger(Node, 'SectorCount', 0); 351 352 NewNode := Node.FindNode('Changes'); 353 if Assigned(NewNode) then begin 354 FChanges.Count := 0; 355 NewNode2 := NewNode.FirstChild; 356 while Assigned(NewNode2) and (NewNode2.NodeName = 'Change') do begin 357 NewChange := TChange.Create; 358 NewChange.Index := ReadInteger(NewNode2, 'Index', 0); 359 NewChange.Value := TSectorState(ReadInteger(NewNode2, 'Value', 0)); 360 FChanges.Add(NewChange); 361 NewNode2 := NewNode2.NextSibling; 362 end; 363 end; 364 end; 323 365 324 366 end. -
trunk/UDriveScan.pas
r6 r7 6 6 7 7 uses 8 Classes, SysUtils, Syncobjs, UBlockMap, Forms, UConfig; 8 Classes, SysUtils, Syncobjs, UBlockMap, Forms, UConfig, DOM, XMLRead, XMLWrite, 9 UXMLUtils, Contnrs; 9 10 10 11 type … … 47 48 constructor Create; 48 49 destructor Destroy; override; 50 procedure SaveToNode(Node: TDOMNode); 51 procedure LoadFromNode(Node: TDOMNode); 49 52 property OnTerminate: TNotifyEvent read FOnTerminate write FOnTerminate; 50 53 property OnChange: TNotifyEvent read FOnChange write FOnChange; 51 54 end; 52 55 56 { TDriveScanList } 57 58 TDriveScanList = class(TObjectList) 59 procedure SaveToNode(Node: TDOMNode); 60 procedure LoadFromNode(Node: TDOMNode); 61 end; 62 53 63 54 64 implementation … … 56 66 resourcestring 57 67 SUnknownRunMode = 'Unknown run mode'; 68 69 { TDriveScanList } 70 71 procedure TDriveScanList.SaveToNode(Node: TDOMNode); 72 var 73 I: Integer; 74 NewNode2: TDOMNode; 75 begin 76 for I := 0 to Count - 1 do 77 with TDriveScan(Items[I]) do begin 78 NewNode2 := Node.OwnerDocument.CreateElement('Scan'); 79 Node.AppendChild(NewNode2); 80 SaveToNode(NewNode2); 81 end; 82 end; 83 84 procedure TDriveScanList.LoadFromNode(Node: TDOMNode); 85 var 86 Node2: TDOMNode; 87 NewScan: TDriveScan; 88 begin 89 Count := 0; 90 Node2 := Node.FirstChild; 91 while Assigned(Node2) and (Node2.NodeName = 'Scan') do begin 92 NewScan := TDriveScan.Create; 93 NewScan.LoadFromNode(Node2); 94 Add(NewScan); 95 Node2 := Node2.NextSibling; 96 end; 97 end; 58 98 59 99 … … 174 214 end; 175 215 216 procedure TDriveScan.SaveToNode(Node: TDOMNode); 217 var 218 NewNode: TDOMNode; 219 begin 220 with Node do begin 221 WriteInteger(Node, 'DamagedBlockCount', DamagedBlockCount); 222 WriteInteger(Node, 'WritePattern', WritePattern); 223 WriteString(Node, 'DriveName', Drive); 224 225 NewNode := OwnerDocument.CreateElement('SectorMap'); 226 AppendChild(NewNode); 227 BlockMap.SaveToNode(NewNode); 228 end; 229 end; 230 231 procedure TDriveScan.LoadFromNode(Node: TDOMNode); 232 var 233 NewNode: TDOMNode; 234 begin 235 with Node do begin 236 DamagedBlockCount := ReadInteger(Node, 'DamagedBlockCount', 0); 237 WritePattern := ReadInteger(Node, 'WritePattern', 0); 238 Drive := ReadString(Node, 'DriveName', ''); 239 240 NewNode := FindNode('SectorMap'); 241 if Assigned(NewNode) then 242 BlockMap.LoadFromNode(NewNode); 243 end; 244 end; 176 245 177 246 end. -
trunk/UFormMain.lfm
r4 r7 1 1 object FormMain: TFormMain 2 Left = 3012 Left = 442 3 3 Height = 941 4 Top = 36 14 Top = 366 5 5 Width = 1703 6 6 Caption = 'CoolDisk' 7 ClientHeight = 9 397 ClientHeight = 909 8 8 ClientWidth = 1703 9 9 Menu = MainMenu1 … … 36 36 object Image1: TImage 37 37 Left = 592 38 Height = 90838 Height = 878 39 39 Top = 10 40 40 Width = 1092 … … 248 248 ParentColor = False 249 249 end 250 object MainMenu1: TMainMenu251 left = 323252 top = 288253 end254 250 object Timer1: TTimer 255 251 Interval = 500 … … 277 273 OnExecute = ABrowseDiskExecute 278 274 end 275 object AExit: TAction 276 Caption = 'Exit' 277 OnExecute = AExitExecute 278 end 279 object AFileSaveAs: TAction 280 Caption = 'Save as...' 281 OnExecute = AFileSaveAsExecute 282 end 283 object AFileOpen: TAction 284 Caption = 'Open' 285 OnExecute = AFileOpenExecute 286 end 279 287 end 280 288 object OpenDialog1: TOpenDialog … … 282 290 top = 360 283 291 end 292 object SaveDialog1: TSaveDialog 293 left = 672 294 top = 432 295 end 296 object MainMenu1: TMainMenu 297 left = 672 298 top = 504 299 object MenuItem1: TMenuItem 300 Caption = 'File' 301 object MenuItem2: TMenuItem 302 Action = AFileOpen 303 end 304 object MenuItem3: TMenuItem 305 Action = AFileSaveAs 306 end 307 object MenuItem4: TMenuItem 308 Action = AExit 309 end 310 end 311 object MenuItem5: TMenuItem 312 Caption = 'Scan' 313 object MenuItem6: TMenuItem 314 Action = AScanStart 315 end 316 object MenuItem7: TMenuItem 317 Action = AScanStop 318 end 319 object MenuItem8: TMenuItem 320 Action = AScanOptions 321 end 322 end 323 end 284 324 end -
trunk/UFormMain.pas
r6 r7 15 15 TFormMain = class(TForm) 16 16 ABrowseDisk: TAction; 17 AFileOpen: TAction; 18 AFileSaveAs: TAction; 19 AExit: TAction; 17 20 AScanOptions: TAction; 18 21 AScanStart: TAction; … … 48 51 ListView1: TListView; 49 52 MainMenu1: TMainMenu; 53 MenuItem1: TMenuItem; 54 MenuItem2: TMenuItem; 55 MenuItem3: TMenuItem; 56 MenuItem4: TMenuItem; 57 MenuItem5: TMenuItem; 58 MenuItem6: TMenuItem; 59 MenuItem7: TMenuItem; 60 MenuItem8: TMenuItem; 50 61 OpenDialog1: TOpenDialog; 62 SaveDialog1: TSaveDialog; 51 63 Timer1: TTimer; 52 64 procedure ABrowseDiskExecute(Sender: TObject); 65 procedure AExitExecute(Sender: TObject); 66 procedure AFileOpenExecute(Sender: TObject); 67 procedure AFileSaveAsExecute(Sender: TObject); 53 68 procedure AScanOptionsExecute(Sender: TObject); 54 69 procedure AScanStartExecute(Sender: TObject); … … 102 117 begin 103 118 PrefixMultiplier := TPrefixMultiplier.Create; 104 DriveScan := TDriveScan.Create; 119 Project := TProject.Create; 120 Project.Scans.Add(TDriveScan.Create); 121 DriveScan := TDriveScan(Project.Scans[0]); 105 122 DriveScan.OnChange := DriveScanChange; 106 123 DriveScan.OnTerminate := DriveScanTerminate; 107 Project := TProject.Create;108 124 EditDrive.Text := '/dev/sdb'; 109 125 end; … … 137 153 begin 138 154 OpenDialog1.Title := 'Select drive for scan'; 155 OpenDialog1.DefaultExt := ''; 139 156 OpenDialog1.FileName := EditDrive.Text; 140 157 if OpenDialog1.Execute then … … 142 159 end; 143 160 161 procedure TFormMain.AExitExecute(Sender: TObject); 162 begin 163 Close; 164 end; 165 166 procedure TFormMain.AFileOpenExecute(Sender: TObject); 167 begin 168 OpenDialog1.Title := 'Open stored scan project'; 169 OpenDialog1.DefaultExt := '.cdp'; 170 if OpenDialog1.Execute then begin 171 Project.LoadFromFile(OpenDialog1.FileName); 172 end; 173 end; 174 175 procedure TFormMain.AFileSaveAsExecute(Sender: TObject); 176 begin 177 SaveDialog1.Title := 'Save scan project'; 178 SaveDialog1.DefaultExt := '.cdp'; 179 if SaveDialog1.Execute then begin 180 Project.SaveToFile(SaveDialog1.FileName); 181 end; 182 end; 183 144 184 procedure TFormMain.FormClose(Sender: TObject; var CloseAction: TCloseAction); 145 185 begin … … 150 190 Timer1.Enabled := False; 151 191 FreeAndNil(Project); 152 FreeAndNil(DriveScan);153 192 FreeAndNil(PrefixMultiplier); 154 193 end; -
trunk/UProject.pas
r2 r7 6 6 7 7 uses 8 Classes, SysUtils ;8 Classes, SysUtils, Contnrs, DOM, XMLRead, XMLWrite, UXMLUtils, UDriveScan; 9 9 10 10 type … … 20 20 SectorCount: Integer; 21 21 Modified: Boolean; 22 Scans: TDriveScanList; 22 23 constructor Create; 24 destructor Destroy; override; 25 procedure LoadFromFile(FileName: string); 26 procedure SaveToFile(FileName: string); 23 27 end; 24 28 29 25 30 implementation 31 32 resourcestring 33 SWrongFileFormat = 'Wrong file format'; 34 26 35 27 36 { TProject } … … 30 39 begin 31 40 SectorSize := 4096; 41 Scans := TDriveScanList.Create; 32 42 end; 43 44 destructor TProject.Destroy; 45 begin 46 FreeAndNil(Scans); 47 inherited Destroy; 48 end; 49 50 procedure TProject.SaveToFile(FileName: string); 51 var 52 NewNode: TDOMNode; 53 Doc: TXMLDocument; 54 RootNode: TDOMNode; 55 begin 56 Self.FileName := FileName; 57 Doc := TXMLDocument.Create; 58 with Doc do try 59 RootNode := CreateElement('CoolDiskProject'); 60 AppendChild(RootNode); 61 with RootNode do begin 62 WriteInteger(RootNode, 'SectorSize', SectorSize); 63 64 NewNode := OwnerDocument.CreateElement('Scans'); 65 AppendChild(NewNode); 66 Scans.SaveToNode(NewNode); 67 end; 68 ForceDirectories(ExtractFileDir(FileName)); 69 WriteXMLFile(Doc, FileName); 70 finally 71 Doc.Free; 72 end; 73 end; 74 75 procedure TProject.LoadFromFile(FileName: string); 76 var 77 Doc: TXMLDocument; 78 RootNode: TDOMNode; 79 NewNode: TDOMNode; 80 begin 81 Self.FileName := FileName; 82 ReadXMLFile(Doc, FileName); 83 with Doc do try 84 if Doc.DocumentElement.NodeName <> 'CoolDiskProject' then 85 raise Exception.Create(SWrongFileFormat); 86 RootNode := Doc.DocumentElement; 87 with RootNode do begin 88 SectorSize := ReadInteger(RootNode, 'SectorSize', 4096); 89 90 NewNode := FindNode('Scans'); 91 if Assigned(NewNode) then 92 Scans.LoadFromNode(NewNode); 93 end; 94 finally 95 Doc.Free; 96 end; 97 end; 98 33 99 34 100 end.
Note:
See TracChangeset
for help on using the changeset viewer.