Changeset 17
- Timestamp:
- Apr 2, 2016, 8:57:38 PM (9 years ago)
- Location:
- trunk
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Form/UFormMain.pas
r16 r17 225 225 begin 226 226 with Core.Project do 227 if DriveInfo.Path <> TDriveInfo(ComboBoxDrive.Items.Objects[ComboBoxDrive.ItemIndex]).Paththen begin227 if (ComboBoxDrive.ItemIndex <> -1) and (DriveInfo.Path <> TDriveInfo(ComboBoxDrive.Items.Objects[ComboBoxDrive.ItemIndex]).Path) then begin 228 228 DriveInfo.Assign(TDriveInfo(ComboBoxDrive.Items.Objects[ComboBoxDrive.ItemIndex])); 229 229 Modified := True; -
trunk/UDriveScan.pas
r16 r17 6 6 7 7 uses 8 Classes, SysUtils, Syncobjs, UBlockMap, Forms, UConfig, DOM, XMLRead, XMLWrite,8 Classes, SysUtils, Syncobjs, UBlockMap, Forms, DOM, 9 9 UXMLUtils, Contnrs; 10 10 … … 13 13 14 14 TRunMode = (rmRead, rmWrite); 15 TExceptionEvent = procedure (Sender: TObject; E: Exception) of object; 15 16 16 17 { TScanThread } 17 18 18 19 TScanThread = class(TThread) 20 private 21 FOnException: TExceptionEvent; 22 public 19 23 Scan: TDriveScan; 24 ExceptionText: string; 20 25 procedure Execute; override; 26 property OnException: TExceptionEvent read FOnException write FOnException; 21 27 end; 22 28 … … 30 36 FSectorCurrent: Integer; 31 37 ScanThread: TScanThread; 38 LastExceptionMessage: string; 39 procedure DoOnExceptionSync; 40 procedure DoOnException(Sender: TObject; E: Exception); 32 41 procedure DoChange; 33 42 procedure DoTerminate; … … 111 120 procedure TScanThread.Execute; 112 121 begin 113 Scan.Run; 122 ExceptionText := ''; 123 try 124 Scan.Run; 125 except 126 on E: Exception do 127 if Assigned(FOnException) then FOnException(Self, E); 128 end; 114 129 end; 115 130 116 131 { TDriveScan } 132 133 procedure TDriveScan.DoOnExceptionSync; 134 begin 135 raise Exception.Create(LastExceptionMessage); 136 end; 137 138 procedure TDriveScan.DoOnException(Sender: TObject; E: Exception); 139 begin 140 LastExceptionMessage := E.Message; 141 TThread(Sender).Synchronize(TThread(Sender), DoOnExceptionSync); 142 end; 117 143 118 144 procedure TDriveScan.DoChange; … … 151 177 Terminated := False; 152 178 ScanThread := TScanThread.Create(True); 179 ScanThread.OnException := DoOnException; 153 180 ScanThread.Scan := Self; 154 181 ScanThread.Start; … … 163 190 begin 164 191 try 165 Lock.Acquire; 166 Terminated := False; 167 if Mode = rmRead then F := TFileStream.Create(DriveName, fmOpenRead) 168 else if Mode = rmWrite then F := TFileStream.Create(DriveName, fmOpenReadWrite); 169 try 170 SetLength(Buffer, SectorSize); 171 if Mode = rmWrite then 172 FillChar(Buffer[0], Length(Buffer), WritePattern); 173 while FSectorCurrent < SectorEnd do begin 192 Lock.Acquire; 193 Terminated := False; 194 if Mode = rmRead then F := TFileStream.Create(DriveName, fmOpenRead) 195 else if Mode = rmWrite then F := TFileStream.Create(DriveName, fmOpenReadWrite); 174 196 try 175 Lock.Release; 176 DoChange; 177 F.Position := FSectorCurrent * SectorSize; 178 if Mode = rmRead then RealSize := F.Read(Buffer[0], SectorSize) 179 else if Mode = rmWrite then RealSize := F.Write(Buffer[0], SectorSize) 180 else raise Exception.Create(SUnknownRunMode); 197 SetLength(Buffer, SectorSize); 198 if Mode = rmWrite then 199 FillChar(Buffer[0], Length(Buffer), WritePattern); 200 while FSectorCurrent < SectorEnd do begin 201 try 202 Lock.Release; 203 DoChange; 204 F.Position := FSectorCurrent * SectorSize; 205 if Mode = rmRead then RealSize := F.Read(Buffer[0], SectorSize) 206 else if Mode = rmWrite then RealSize := F.Write(Buffer[0], SectorSize) 207 else raise Exception.Create(SUnknownRunMode); 208 finally 209 Lock.Acquire; 210 end; 211 if RealSize <> SectorSize then begin 212 BlockMap.Sectors[FSectorCurrent] := bsDamaged; 213 Inc(DamagedBlockCount); 214 end else BlockMap.Sectors[FSectorCurrent] := bsOk; 215 Inc(FSectorCurrent); 216 if Terminated then Break; 217 end; 181 218 finally 182 Lock.Acquire;219 F.Free; 183 220 end; 184 if RealSize <> SectorSize then begin185 BlockMap.Sectors[FSectorCurrent] := bsDamaged;186 Inc(DamagedBlockCount);187 end else BlockMap.Sectors[FSectorCurrent] := bsOk;188 Inc(FSectorCurrent);189 if Terminated then Break;190 end;191 finally192 F.Free;193 end;194 221 finally 195 222 Lock.Release;
Note:
See TracChangeset
for help on using the changeset viewer.