biffexplorer: Fix possible bufferoverruns. Fix hex editor font in Linux.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4519 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2016-02-21 17:42:13 +00:00
parent 0debf57411
commit 3d772b90c6
4 changed files with 130 additions and 63 deletions
--- a/applications/biffexplorer/BIFFExplorer.lpi
+++ b/applications/biffexplorer/BIFFExplorer.lpi
@ -123,12 +123,12 @@
        <IsPartOfProject Value="True"/>
      </Unit0>
      <Unit1>
-        <Filename Value="beabout.pas"/>
+        <Filename Value="bemain.pas"/>
        <IsPartOfProject Value="True"/>
-        <ComponentName Value="AboutForm"/>
+        <ComponentName Value="MainForm"/>
        <HasResources Value="True"/>
        <ResourceBaseClass Value="Form"/>
-        <UnitName Value="beAbout"/>
+        <UnitName Value="beMain"/>
      </Unit1>
      <Unit2>
        <Filename Value="bebiffgrid.pas"/>
@ -145,12 +145,12 @@
        <IsPartOfProject Value="True"/>
      </Unit4>
      <Unit5>
-        <Filename Value="bemain.pas"/>
+        <Filename Value="beabout.pas"/>
        <IsPartOfProject Value="True"/>
-        <ComponentName Value="MainForm"/>
+        <ComponentName Value="AboutForm"/>
        <HasResources Value="True"/>
        <ResourceBaseClass Value="Form"/>
-        <UnitName Value="beMain"/>
+        <UnitName Value="beAbout"/>
      </Unit5>
      <Unit6>
        <Filename Value="beutils.pas"/>
--- a/applications/biffexplorer/bemain.lfm
+++ b/applications/biffexplorer/bemain.lfm
@ -17,61 +17,23 @@ object MainForm: TMainForm
  LCLVersion = '1.7'
  object Splitter1: TSplitter
    Left = 419
-    Height = 508
-    Top = 25
+    Height = 483
+    Top = 50
    Width = 5
  end
-  object ToolBar: TToolBar
-    Left = 4
-    Height = 25
-    Top = 0
-    Width = 1085
-    AutoSize = True
-    BorderSpacing.Left = 4
-    ButtonHeight = 25
-    Caption = 'ToolBar'
-    EdgeBorders = []
-    Images = ImageList
-    TabOrder = 1
-    object ToolButton1: TToolButton
-      Left = 1
-      Top = 0
-      Action = AcFileOpen
-      DropdownMenu = RecentFilesPopupMenu
-      Style = tbsDropDown
-    end
-    object ToolButton2: TToolButton
-      Left = 64
-      Top = 0
-      Action = AcFileQuit
-    end
-    object ToolButton3: TToolButton
-      Left = 36
-      Top = 0
-      Action = AcFind
-    end
-    object ToolButton4: TToolButton
-      Left = 59
-      Height = 25
-      Top = 0
-      Width = 5
-      Caption = 'ToolButton4'
-      Style = tbsDivider
-    end
-  end
  object DetailPanel: TPanel
    Left = 424
-    Height = 508
-    Top = 25
+    Height = 483
+    Top = 50
    Width = 665
    Align = alClient
    BevelOuter = bvNone
-    ClientHeight = 508
+    ClientHeight = 483
    ClientWidth = 665
-    TabOrder = 3
+    TabOrder = 2
    object PageControl: TPageControl
      Left = 0
-      Height = 508
+      Height = 483
      Top = 0
      Width = 665
      ActivePage = PgValues
@ -111,12 +73,12 @@ object MainForm: TMainForm
      end
      object PgValues: TTabSheet
        Caption = 'Values'
-        ClientHeight = 480
+        ClientHeight = 455
        ClientWidth = 657
        object ValueGrid: TStringGrid
          Left = 0
          Height = 158
-          Top = 322
+          Top = 297
          Width = 657
          Align = alBottom
          ColCount = 3
@ -151,14 +113,14 @@ object MainForm: TMainForm
          Cursor = crVSplit
          Left = 0
          Height = 5
-          Top = 317
+          Top = 292
          Width = 657
          Align = alBottom
          ResizeAnchor = akBottom
        end
        object HexEditor: TKHexEditor
          Left = 0
-          Height = 286
+          Height = 261
          Top = 31
          Width = 657
          AddressPrefix = '$'
@ -236,19 +198,19 @@ object MainForm: TMainForm
  end
  object TreePanel: TPanel
    Left = 0
-    Height = 508
-    Top = 25
+    Height = 483
+    Top = 50
    Width = 419
    Align = alLeft
    BevelOuter = bvNone
-    ClientHeight = 508
+    ClientHeight = 483
    ClientWidth = 419
    Constraints.MinWidth = 275
-    TabOrder = 2
+    TabOrder = 1
    object FindPanel: TPanel
      Left = 0
      Height = 30
-      Top = 478
+      Top = 453
      Width = 419
      Align = alBottom
      BevelOuter = bvNone
@ -293,7 +255,7 @@ object MainForm: TMainForm
    end
    object BIFFTree: TVirtualStringTree
      Left = 0
-      Height = 478
+      Height = 453
      Top = 0
      Width = 419
      Align = alClient
@ -373,6 +335,64 @@ object MainForm: TMainForm
      end>
    SimplePanel = False
  end
+  object CoolBar: TCoolBar
+    Left = 0
+    Height = 50
+    Top = 0
+    Width = 1089
+    AutoSize = True
+    Bands = <    
+      item
+        Control = ToolBar
+        Width = 1114
+      end>
+    GrabStyle = gsGripper
+    object ToolBar: TToolBar
+      AnchorSideLeft.Control = CoolBar
+      AnchorSideTop.Control = CoolBar
+      Left = 24
+      Height = 40
+      Top = 5
+      Width = 1085
+      Align = alNone
+      AutoSize = True
+      BorderSpacing.Left = 22
+      BorderSpacing.Top = 3
+      ButtonHeight = 40
+      ButtonWidth = 40
+      Caption = 'ToolBar'
+      EdgeBorders = []
+      Images = ImageList
+      ShowCaptions = True
+      TabOrder = 0
+      Transparent = True
+      object ToolButton1: TToolButton
+        Left = 1
+        Top = 0
+        Action = AcFileOpen
+        DropdownMenu = RecentFilesPopupMenu
+        Style = tbsDropDown
+      end
+      object ToolButton2: TToolButton
+        Left = 98
+        Top = 0
+        Action = AcFileQuit
+      end
+      object ToolButton3: TToolButton
+        Left = 53
+        Top = 0
+        Action = AcFind
+      end
+      object ToolButton4: TToolButton
+        Left = 93
+        Height = 40
+        Top = 0
+        Width = 5
+        Caption = 'ToolButton4'
+        Style = tbsDivider
+      end
+    end
+  end
  object ImageList: TImageList
    left = 80
    top = 64
--- a/applications/biffexplorer/bemain.pas
+++ b/applications/biffexplorer/bemain.pas
@ -35,6 +35,7 @@ type
    CbHexAddress: TCheckBox;
    CbHexEditorLineSize: TComboBox;
    CbHexSingleBytes: TCheckBox;
+    CoolBar: TCoolBar;
    ImageList: TImageList;
    HexEditor: TKHexEditor;
    MainMenu: TMainMenu;
@ -687,8 +688,11 @@ begin
    OnRecentFile := @MRUMenuManagerRecentFile;
  end;

+  HexEditor.Font.Name := GetFixedFontName;  // The hard-coded Courier New does not exist in Linux
  HexEditor.Font.Style := [];

+  AnalysisDetails.Font.Name := HexEditor.Font.Name;
+
  FAnalysisGrid := TBIFFGrid.Create(self);
  with FAnalysisGrid do begin
    Parent := PgAnalysis;
@ -1022,6 +1026,9 @@ var
  s: String;
  sw: WideString;
  ls: Integer;
+  len: SizeInt;
+  pw: PWideChar;
+  p: PChar;
 begin
  idx := FCurrOffset;
 //  idx := HexEditor.SelStart.Index;
@ -1122,7 +1129,16 @@ begin
    ValueGrid.Cells[2, VALUE_ROW_ANSISTRING] := '';
  end;

-  s := StrPas(PChar(@FBuffer[idx]));
+  // Avoid buffer overrun
+  p := PChar(@FBuffer[idx]);
+  len := 0;
+  while (p^ <> #0) and (p - @FBuffer[0] < Length(FBuffer)) do
+  begin
+    inc(p);
+    inc(len);
+  end;
+  SetLength(s, len);
+  Move(FBuffer[idx], s[1], len);
  ValueGrid.Cells[1, VALUE_ROW_PANSICHAR] := s;
  ValueGrid.Cells[2, VALUE_ROW_PANSICHAR] := Format('%d ... %d', [idx, idx + Length(s)]);

@ -1146,7 +1162,15 @@ begin
    ValueGrid.Cells[2, VALUE_ROW_WIDESTRING] := '';
  end;

-  s := UTF8Encode(StrPas(PWideChar(@FBuffer[idx])));
+  // Avoid buffer overrun
+  pw := PWideChar(@FBuffer[idx]);
+  len := 0;
+  while (pw^ <> #0) and (pw - @FBuffer[0] < Length(FBuffer)-1) do
+  begin
+    inc(pw);
+    inc(len);
+  end;
+  s := {%H-}WideCharLenToString(PWideChar(@FBuffer[idx]), len);
  ValueGrid.Cells[1, VALUE_ROW_PWIDECHAR] := s;
  ValueGrid.Cells[2, VALUE_ROW_PWIDECHAR] := Format('%d ... %d', [idx, idx + Length(s)]);
 end;
--- a/applications/biffexplorer/beutils.pas
+++ b/applications/biffexplorer/beutils.pas
@ -16,6 +16,8 @@ function GetFileFormatName(AFormat: TsSpreadsheetFormat): String;
 function GetFormatFromFileHeader(const AFileName: TFileName;
  out SheetType: TsSpreadsheetFormat): Boolean;

+function GetFixedFontName: String;
+

 implementation

@ -161,5 +163,26 @@ begin
  end;
 end;

+
+function GetFixedFontName: String;
+var
+  idx: Integer;
+begin
+  Result := Screen.SystemFont.Name;
+  idx := Screen.Fonts.IndexOf('Courier New');
+  if idx = -1 then
+    idx := Screen.Fonts.IndexOf('Courier 10 Pitch');
+  if idx <> -1 then
+    Result := Screen.Fonts[idx]
+  else
+    for idx := 0 to Screen.Fonts.Count-1 do
+      if pos('courier', Lowercase(Screen.Fonts[idx])) = 1 then
+      begin
+        Result := Screen.Fonts[idx];
+        exit;
+      end;
+end;
+
+
 end.