← Back to branch summary

~ubuntu-branches/ubuntu/vivid/ddrescueview/vivid-backports

« back to all changes in this revision

Viewing changes to source/Shared.pas

  • Committer: Package Import Robot
  • Author(s): Graham Inggs
  • Date: 2015-06-02 12:30:03 UTC
  • mfrom: (1.1.1)
  • Revision ID: package-import@ubuntu.com-20150602123003-vq5snysd2m5i20ek
Tags: 0.4~alpha2-1
* New upstream release
* Update d/rules, d/watch since upstream now ship an xz-compressed tarball
* Drop d/patches/linker-options.patch included upstream
* Drop manpage, desktop file and xpm icon since these files are now shipped
  by upstream, update d/ddrecueview.install, d/manpages accordingly
* Add build-depends on libgtk2.0-dev

Show diffs side-by-side

added added

removed removed

Lines of Context:
source/Shared.pas
20
20
*)
21
21
 
22
22
unit Shared;
 
23
{$inline on}
23
24
 
24
25
(* This unit contains shared functionality, especially constants,
25
26
   types and essential functions for multiple parts of the program *)
45
46
    bad : int64;
46
47
    nonscraped : int64;
47
48
    nontrimmed : int64;
 
49
    outsidedomain : int64;
48
50
    errors : int64;
49
51
    curOperation : Char;
50
52
    strCurOperation : String;
51
53
  end;
 
54
  (* size display object *)
 
55
  TSFRounding = (rShortInt, rShortFloat, rSector, rNone);
 
56
  TSFBase = (bDec, bHex);
 
57
  TSFPrefix = (pDec, pBin);
 
58
  TSizeFormat = object
 
59
    Rounding : TSFRounding;
 
60
    Base : TSFBase;
 
61
    Prefix : TSFPrefix;
 
62
    SectSize : Longint;
 
63
    function SizeStr(size: Int64): String;
 
64
  end;
 
65
  (* Extend the IFPObserved intf to have Attach/detach wrappers
 
66
     that can be implemented as public methods by implementing classes.
 
67
     This would make these classes actually 'attachable' from the outside. *)
52
68
  IAttachableObserved = Interface(IFPObserved)
53
 
    (* Extend the IFPObserved intf to have Attach/detach wrappers
54
 
       that can be implemented as public methods by implementing classes.
55
 
       This would make these classes actually 'attachable' from the outside. *)
56
69
    procedure AttachObserver(AObserver : TObject);
57
70
    procedure DetachObserver(AObserver : TObject);
58
71
  end;
73
86
  // the lower 24 bits contain the color used for display.
74
87
  // The actual display color is blended together from the flags
75
88
  // in the upper 8 bits by ColorizeBlockMask
76
 
  MASK_NON_TRIED = $01000000;
77
 
  MASK_NON_TRIMMED = $02000000;
78
 
  MASK_NON_SCRAPED = $04000000;
79
 
  MASK_BAD_SECT = $08000000;
80
 
  MASK_FINISHED = $10000000;
81
 
  MASK_ALL_STATUSES = $1F000000;
82
 
  MASK_ACTIVE = $20000000;
83
 
  MASKS : array[0..4] of Longint =
84
 
    (MASK_NON_TRIED, MASK_FINISHED, MASK_NON_TRIMMED, MASK_NON_SCRAPED, MASK_BAD_SECT);
 
89
  MASK_OUTSIDE_DOMAIN = $01000000;
 
90
  MASK_NON_TRIED = $02000000;
 
91
  MASK_NON_TRIMMED = $04000000;
 
92
  MASK_NON_SCRAPED = $08000000;
 
93
  MASK_BAD_SECT = $10000000;
 
94
  MASK_FINISHED = $20000000;
 
95
  MASK_ALL_STATUSES = $3F000000;
 
96
  MASK_ACTIVE = $40000000;
 
97
  MASKS : array[0..5] of Longint =
 
98
    (MASK_OUTSIDE_DOMAIN, MASK_NON_TRIED, MASK_FINISHED, MASK_NON_TRIMMED,
 
99
     MASK_NON_SCRAPED, MASK_BAD_SECT);
85
100
 
86
 
  // color defaults for the block statuses
 
101
  // color defaults
 
102
  DEF_COLOR_OUTSIDE_DOMAIN = $343434;
87
103
  DEF_COLOR_NON_TRIED = $909090;
88
104
  DEF_COLOR_NON_TRIMMED = $00e0ff;
89
105
  DEF_COLOR_NON_SCRAPED = $ff2020;
91
107
  DEF_COLOR_FINISHED = $20e020;
92
108
  DEF_COLOR_UNDEFINED = $606060;
93
109
  DEF_COLOR_ACTIVE = $ffff00;
 
110
  DEF_COLOR_SELECTED = $ffffff;
 
111
  COLOR_HIGHLIGHT = clBlack;
94
112
 
95
113
  // color weight defaults to be used by ColorizeBlockMask for blending
96
 
  DEF_WEIGHT_NON_TRIED = 1;
97
 
  DEF_WEIGHT_FINISHED = 2;
98
 
  DEF_WEIGHT_NON_TRIMMED = 4;
99
 
  DEF_WEIGHT_NON_SCRAPED = 10;
100
 
  DEF_WEIGHT_BAD_SECT = 40;
 
114
  DEF_WEIGHT_OUTSIDE_DOMAIN = 1;
 
115
  DEF_WEIGHT_NON_TRIED = 3;
 
116
  DEF_WEIGHT_FINISHED = 5;
 
117
  DEF_WEIGHT_NON_TRIMMED = 12;
 
118
  DEF_WEIGHT_NON_SCRAPED = 20;
 
119
  DEF_WEIGHT_BAD_SECT = 80;
101
120
 
102
121
  // color primary masks
103
122
  MASK_B = $ff0000;
107
126
  // default device block size
108
127
  DEF_BSIZE = 512;
109
128
 
110
 
  PROGRAM_TITLE = 'ddrescue log viewer';
 
129
  PROGRAM_TITLE = 'ddrescueview';
111
130
  VERSION_MAJOR = '0';
112
 
  VERSION_MINOR = '4 alpha';
 
131
  VERSION_MINOR = '4';
 
132
  VERSION_SUFFIX = 'alpha 2';
113
133
  emptyRescueStatus : TRescueStatus =
114
 
  (devicesize : 0; suggestedBlockSize : DEF_BSIZE; pos : 0; rescued : 0; nontried : 0; bad : 0;
115
 
   nonscraped : 0; nontrimmed : 0; errors : 0; curOperation : #0; strCurOperation : '');
 
134
  (devicesize : 0; suggestedBlockSize : DEF_BSIZE; pos : 0; rescued : 0;
 
135
   nontried : 0; bad : 0; nonscraped : 0; nontrimmed : 0; outsidedomain : 0;
 
136
   errors : 0; curOperation : #0; strCurOperation : '');
116
137
 
117
138
var
118
139
  useDecimalUnits : boolean = true;
119
 
  // colors for the block statuses
120
 
  COLOR_NON_TRIED : Longint = $909090;
121
 
  COLOR_NON_TRIMMED : Longint = $00e0ff;
122
 
  COLOR_NON_SCRAPED : Longint = $ff2020;
123
 
  COLOR_BAD_SECT : Longint = $0000ff;
124
 
  COLOR_FINISHED : Longint = $20e020;
125
 
  COLOR_UNDEFINED : Longint = $606060;
126
 
  COLOR_ACTIVE : Longint = $ffff00;
 
140
  // colors variables
 
141
  COLOR_OUTSIDE_DOMAIN : Longint = DEF_COLOR_OUTSIDE_DOMAIN;
 
142
  COLOR_NON_TRIED : Longint = DEF_COLOR_NON_TRIED;
 
143
  COLOR_NON_TRIMMED : Longint = DEF_COLOR_NON_TRIMMED;
 
144
  COLOR_NON_SCRAPED : Longint = DEF_COLOR_NON_SCRAPED;
 
145
  COLOR_BAD_SECT : Longint = DEF_COLOR_BAD_SECT;
 
146
  COLOR_FINISHED : Longint = DEF_COLOR_FINISHED;
 
147
  COLOR_UNDEFINED : Longint = DEF_COLOR_UNDEFINED;
 
148
  COLOR_ACTIVE : Longint = DEF_COLOR_ACTIVE;
 
149
  COLOR_SELECTED : Longint = DEF_COLOR_SELECTED;
127
150
  // color weights to be used by ColorizeBlockMask for blending
128
 
  WEIGHT_NON_TRIED : Longint = 1;
129
 
  WEIGHT_FINISHED : Longint = 2;
130
 
  WEIGHT_NON_TRIMMED : Longint = 4;
131
 
  WEIGHT_NON_SCRAPED : Longint = 10;
132
 
  WEIGHT_BAD_SECT : Longint = 40;
133
 
  // arrays containing the above constants for easier looping
134
 
  COLORS : array[0..4] of ^Longint =
135
 
    (@COLOR_NON_TRIED, @COLOR_FINISHED, @COLOR_NON_TRIMMED, @COLOR_NON_SCRAPED, @COLOR_BAD_SECT);
136
 
  WEIGHTS : array[0..4] of ^Longint =
137
 
    (@WEIGHT_NON_TRIED, @WEIGHT_FINISHED, @WEIGHT_NON_TRIMMED, @WEIGHT_NON_SCRAPED, @WEIGHT_BAD_SECT);
 
151
  WEIGHT_OUTSIDE_DOMAIN : Longint = DEF_WEIGHT_OUTSIDE_DOMAIN;
 
152
  WEIGHT_NON_TRIED : Longint = DEF_WEIGHT_NON_TRIED;
 
153
  WEIGHT_FINISHED : Longint = DEF_WEIGHT_FINISHED;
 
154
  WEIGHT_NON_TRIMMED : Longint = DEF_WEIGHT_NON_TRIMMED;
 
155
  WEIGHT_NON_SCRAPED : Longint = DEF_WEIGHT_NON_SCRAPED;
 
156
  WEIGHT_BAD_SECT : Longint = DEF_WEIGHT_BAD_SECT;
 
157
  // arrays pointing at the above values for easier looping
 
158
  COLORS : array[0..5] of ^Longint =
 
159
    (@COLOR_OUTSIDE_DOMAIN, @COLOR_NON_TRIED, @COLOR_FINISHED,
 
160
     @COLOR_NON_TRIMMED, @COLOR_NON_SCRAPED, @COLOR_BAD_SECT);
 
161
  WEIGHTS : array[0..5] of ^Longint =
 
162
    (@WEIGHT_OUTSIDE_DOMAIN, @WEIGHT_NON_TRIED, @WEIGHT_FINISHED,
 
163
     @WEIGHT_NON_TRIMMED, @WEIGHT_NON_SCRAPED, @WEIGHT_BAD_SECT);
 
164
  // Default size formatters
 
165
  SF_FLOAT : TSizeFormat = (Rounding : rShortFloat; Base : bDec; Prefix : pDec; SectSize : DEF_BSIZE);
 
166
  SF_SECT : TSizeFormat = (Rounding : rSector; Base : bDec; Prefix : pDec; SectSize : DEF_BSIZE);
 
167
  SF_HEX : TSizeFormat = (Rounding : rNone; Base : bHex; Prefix : pDec; SectSize : DEF_BSIZE);
 
168
  SFORMATS : array[0..2] of ^TSizeFormat = (@SF_FLOAT, @SF_SECT, @SF_HEX);
138
169
 
139
170
function BlockStatusToString(status: char) : String;
140
171
function OperationToText(status: char) : string;
141
 
function SizeStr(sizeInBytes : int64): String;
142
172
function BlockOverlap(b1Start, b1End, b2Start, b2End : Int64): Int64;
143
 
 
 
173
function verLT(versionA, versionB : String) : Boolean;
 
174
function blendColors(color1, color2: TColor; intensity1 : integer): TColor; inline;
 
175
function InRangeEx(const AValue, A1, A2: Longint): Boolean; inline;
 
176
function IntersectEntries(entry1, entry2 : TLogEntry): TLogEntry;
 
177
function FilePart(path: String): String;
144
178
 
145
179
implementation
146
180
uses SysUtils, Math;
147
181
 
148
 
 
 
182
// status strings for each block status
149
183
function BlockStatusToString(status: char) : String;
150
184
begin
151
185
  case status of
152
186
    '?': result := 'Non-tried';
 
187
    '+': result := 'Rescued';
153
188
    '*': result := 'Non-trimmed';
154
189
    '/': result := 'Non-scraped';
155
190
    '-': result := 'Bad sector(s)';
156
 
    '+': result := 'Rescued';
 
191
    'd': result := 'Not in domain';
157
192
  else
158
 
    result := 'Unknown status';
 
193
    result := 'Unknown ('+status+')';
159
194
  end;
160
195
end;
161
196
 
163
198
function OperationToText(status: char) : string;
164
199
begin
165
200
  case status of
166
 
    '?': OperationToText := 'Copying non-tried';
167
 
    '*': OperationToText := 'Trimming non-trimmed blocks';
168
 
    '/': OperationToText := 'Scraping non-scraped blocks';
169
 
    '-': OperationToText := 'Retrying bad sectors';
170
 
    'F': OperationToText := 'Filling specified blocks';
171
 
    'G': OperationToText := 'Generating approximate logfile';
172
 
    '+': OperationToText := 'Finished';
 
201
    '?': result := 'Copying non-tried blocks';
 
202
    '*': result := 'Trimming non-trimmed blocks';
 
203
    '/': result := 'Scraping non-scraped blocks';
 
204
    '-': result := 'Retrying bad sectors';
 
205
    'F': result := 'Filling specified blocks';
 
206
    'G': result := 'Generating approximate logfile';
 
207
    '+': result := 'Finished';
173
208
  else
174
 
    OperationToText := 'Unknown operation';
 
209
    result := 'Unknown ('+status+')';
175
210
  end;
176
211
end;
177
212
 
178
 
function SizeStr(sizeInBytes : int64): String;
 
213
function TSizeFormat.SizeStr(size: Int64): String;
 
214
const
 
215
  decPrefixes : array[0..5] of String = ('Byte', 'KB', 'MB', 'GB', 'TB', 'PB');
 
216
  binPrefixes : array[0..5] of String = ('Byte', 'KiB', 'MiB', 'GiB', 'TiB', 'PiB');
 
217
var
 
218
  sPrefix: string;
 
219
  iSectSize, thresh, divisor : Longint;
 
220
  i : integer;
 
221
  iValue : Int64;
 
222
  fValue : double;
179
223
begin
180
 
  if useDecimalUnits then begin
181
 
     if sizeInBytes < 0 then SizeStr := 'invalid size?'
182
 
     else if sizeInBytes < 100000 then SizeStr := IntToStr(sizeInBytes)+ ' Byte'
183
 
     else if sizeInBytes < 100000000 then SizeStr := IntToStr(sizeInBytes div 1000)+ ' KB'
184
 
     else if sizeInBytes < 100000000000 then SizeStr := IntToStr(sizeInBytes div 1000000)+ ' MB'
185
 
     else if sizeInBytes < 100000000000000 then SizeStr := IntToStr(sizeInBytes div 1000000000)+ ' GB'
186
 
     else if sizeInBytes < 100000000000000000 then SizeStr := IntToStr(sizeInBytes div 1000000000000)+ ' TB'
187
 
     else SizeStr := IntToStr(sizeInBytes div 1000000000000000)+ ' PB';
188
 
  end else begin
189
 
     if sizeInBytes < 0 then SizeStr := 'invalid size?'
190
 
     else if sizeInBytes < 102400 then SizeStr := IntToStr(sizeInBytes)+ ' Byte'
191
 
     else if sizeInBytes < 104857600 then SizeStr := IntToStr(sizeInBytes div 1024)+ ' KiB'
192
 
     else if sizeInBytes < 107374182400 then SizeStr := IntToStr(sizeInBytes div 1048576)+ ' MiB'
193
 
     else if sizeInBytes < 109951162777600 then SizeStr := IntToStr(sizeInBytes div 1073741824)+ ' GiB'
194
 
     else if sizeInBytes < 112589990684262400 then SizeStr := IntToStr(sizeInBytes div 1099511627776)+ ' TiB'
195
 
     else SizeStr := IntToStr(sizeInBytes div 1125899906842624)+ ' PiB';
196
 
  end;
 
224
  if Base = bHex then begin
 
225
    result:='0x'+IntToHex(size, 8);
 
226
    exit;
 
227
  end;
 
228
  if Rounding = rSector then begin
 
229
    if SectSize < 1 then iSectSize:=512 else iSectSize:=SectSize;
 
230
    result:=IntToStr(size div iSectSize)+' s';
 
231
    exit;
 
232
  end;
 
233
  if Rounding = rNone then begin
 
234
    result:=IntToStr(size)+' Byte';
 
235
    exit;
 
236
  end;
 
237
  if Prefix = pDec then divisor:=1000 else divisor:=1024;
 
238
  if Rounding = rShortInt then thresh:=divisor*100 else thresh:=divisor;
 
239
  iValue:=size;
 
240
  fValue:=size;
 
241
  i:=0;
 
242
  while i < High(decPrefixes) do begin
 
243
    if Rounding = rShortInt then begin
 
244
      if iValue < thresh then break;
 
245
      iValue := iValue div divisor;
 
246
      inc(i);
 
247
    end else begin
 
248
      if fValue < thresh then break;
 
249
      fValue := fValue / divisor;
 
250
      inc(i);
 
251
    end;
 
252
  end;
 
253
  if Prefix = pDec then sPrefix:=decPrefixes[i] else sPrefix:=binPrefixes[i];
 
254
  if (i = 0) or (Rounding = rShortInt) then result:=IntToStr(iValue)+' '+sPrefix
 
255
  else result:=FloatToStrF(fValue, ffFixed, 12, 2)+' '+sPrefix;
197
256
end;
198
257
 
 
258
// returns the number of bytes by which two blocks on a device overlap.
199
259
function BlockOverlap(b1Start, b1End, b2Start, b2End: Int64): Int64;
200
260
begin
201
261
  BlockOverlap:=Max(0, Min(Min(b1End-b1Start, b2End-b2Start),
202
262
                           Min(b2End-b1Start, b1End-b2Start)));
203
263
end;
204
264
 
 
265
// return the intersection of two log entries. Status is copied from first.
 
266
function IntersectEntries(entry1, entry2 : TLogEntry): TLogEntry;
 
267
begin
 
268
  result.status:=entry1.status;
 
269
  result.length:=BlockOverlap(entry1.offset, entry1.offset+entry1.length,
 
270
                              entry2.offset, entry2.offset+entry2.length);
 
271
  result.offset:=max(entry1.offset, entry2.offset);
 
272
end;
 
273
 
 
274
// returns the file part of a file path
 
275
function FilePart(path: String): String;
 
276
var delimPos : Integer;
 
277
begin
 
278
  delimPos := LastDelimiter('\/:', path);
 
279
  result := Copy(path, delimPos+1, Length(path)-delimPos);
 
280
end;
 
281
 
 
282
// compare two version strings and return true if versionA is less than versionB
 
283
// could be used with TParser.Version in the future to adapt to ddrescue versions
 
284
function verLT(versionA, versionB : String) : Boolean;
 
285
var
 
286
  listA, listB : TStringList;
 
287
  intsA, intsB : array of integer;
 
288
  i, j : integer;
 
289
begin
 
290
  // set up the string lists
 
291
  listA:=TStringList.Create;
 
292
  listB:=TStringList.Create;
 
293
  listA.StrictDelimiter:=true;
 
294
  listB.StrictDelimiter:=true;
 
295
  listA.Delimiter:='.';
 
296
  listB.Delimiter:='.';
 
297
  // read in the delimited text
 
298
  listA.DelimitedText:=versionA;
 
299
  listB.DelimitedText:=versionB;
 
300
  // Extend both lists to the same length by appending zeroes
 
301
  while listA.Count < listB.Count do listA.Add('0');
 
302
  while listB.Count < listA.Count do listB.Add('0');
 
303
  // strip non-numeric suffixes from the version parts
 
304
  for i := 0 to listA.Count-1 do begin
 
305
    for j := 1 to Length(listA[i]) do begin
 
306
      if not (listA[i][j] in ['0'..'9']) then begin
 
307
        listA[i]:=Copy(listA[i], 1, j-1);
 
308
        break;
 
309
      end;
 
310
    end;
 
311
    for j := 1 to Length(listB[i]) do begin
 
312
      if not (listB[i][j] in ['0'..'9']) then begin
 
313
        listB[i]:=Copy(listB[i], 1, j-1);
 
314
        break;
 
315
      end;
 
316
    end;
 
317
  end;
 
318
  // set up the integer lists.
 
319
  SetLength(intsA, listA.Count);
 
320
  SetLength(intsB, listB.Count);
 
321
  // Convert the string parts of each version to an int list
 
322
  for i := 0 to listA.Count-1 do begin
 
323
    intsA[i]:=StrToIntDef(listA[i], 0);
 
324
    intsB[i]:=StrToIntDef(listB[i], 0);
 
325
  end;
 
326
  // free the lists
 
327
  listA.Free;
 
328
  listB.Free;
 
329
  // Compare the list elements
 
330
  for i := 0 to Length(intsA)-1 do begin
 
331
    if intsA[i] < intsB[i] then exit(true)
 
332
    else if intsB[i] < intsA[i] then exit(false);
 
333
  end;
 
334
  // at this point the versions are equal
 
335
  verLT:=false;
 
336
end;
 
337
 
 
338
// Blends two colors. intensity1 [0..256] determines the strength of color1.
 
339
// intensity1 values over 256 will cause color corruption
 
340
// this is more optimized for speed than for clarity or rounding accuracy.
 
341
function blendColors(color1, color2: TColor; intensity1 : integer): TColor; inline;
 
342
const mask = $FF00FF00FF;
 
343
var tmp: Int64;
 
344
begin
 
345
  tmp:=(((Int64(color1)*$1000001 and mask)*intensity1 +
 
346
         (Int64(color2)*$1000001 and mask)*(256-intensity1)) shr 8) and mask;
 
347
  result:= TColor(tmp) or TColor(tmp shr 24);
 
348
end;
 
349
 
 
350
// allows Min/Max args to be reversed
 
351
function InRangeEx(const AValue, A1, A2: Longint): Boolean; inline;
 
352
begin
 
353
  Result:=((AValue>=A1) and (AValue<=A2)) or ((AValue>=A2) and (AValue<=A1));
 
354
end;
 
355
 
205
356
procedure TObservablePersistent.AttachObserver(AObserver : TObject);
206
357
begin
207
358
  FPOAttachObserver(AObserver);