feat: Implemented Trace Route

cliff.toml

@@ -31,12 +31,12 @@ body = """
 trim = true
 # changelog footer
 footer = """
-For a list of all the changes up to date, please read [CHANGELOG.md](://github.com/gcarreno/re-usable-workflows/blob/main/CHANGELOG.md).
+For a list of all the changes up to date, please read [CHANGELOG.md](://github.com/gcarreno/TestIPScanner/blob/main/CHANGELOG.md).
 <!-- generated by git-cliff -->
 """
 # postprocessors
 postprocessors = [
-  # { pattern = '<REPO>', replace = "https://github.com/orhun/git-cliff" }, # replace repository URL
+  # { pattern = '<REPO>', replace = "https://github.com/gcarreno/TestIPScanner" }, # replace repository URL
 ]
 [git]
 # parse the commits based on https://www.conventionalcommits.org

src/forms/forms.main.lfm

@@ -9,17 +9,18 @@ object frmMain: TfrmMain
   Constraints.MinWidth = 800
   Menu = mmMain
   Position = poDefault
-  SessionProperties = 'edtEndIP.Text;edtStartIP.Text;Height;Left;pcMain.ActivePage;Top;Width;WindowState;edtPingHost.Text'
+  SessionProperties = 'edtEndIP.Text;edtPingHost.Text;edtStartIP.Text;Height;Left;pcMain.ActivePage;Top;Width;WindowState;edtTraceHost.Text'
   OnCreate = FormCreate
   OnDestroy = FormDestroy
+  OnShow = FormShow
   object pcMain: TPageControl
     Left = 0
     Height = 500
     Top = 0
     Width = 800
-    ActivePage = tsPing
+    ActivePage = tsMyIP
     Align = alClient
-    TabIndex = 2
+    TabIndex = 0
     TabOrder = 0
     object tsMyIP: TTabSheet
       Caption = '&My IP'
@@ -66,7 +67,7 @@ object frmMain: TfrmMain
       Caption = '&Scan IP Range'
       ClientHeight = 469
       ClientWidth = 790
-      object lblStartIP: TLabel
+      object lblScanStartIP: TLabel
         Left = 4
         Height = 17
         Top = 4
@@ -76,7 +77,7 @@ object frmMain: TfrmMain
         BorderSpacing.Top = 4
         Caption = 'St&art IP'
       end
-      object edtStartIP: TIPEdit
+      object edtScanStartIP: TIPEdit
         Left = 4
         Height = 34
         Top = 25
@@ -88,7 +89,7 @@ object frmMain: TfrmMain
         TabOrder = 0
         Text = '192.168.  0.  1'
       end
-      object lblEndIP: TLabel
+      object lblScanEndIP: TLabel
         Left = 4
         Height = 17
         Top = 63
@@ -98,7 +99,7 @@ object frmMain: TfrmMain
         BorderSpacing.Top = 4
         Caption = '&End IP'
       end
-      object edtEndIP: TIPEdit
+      object edtScanEndIP: TIPEdit
         Left = 4
         Height = 34
         Top = 84
@@ -108,7 +109,6 @@ object frmMain: TfrmMain
         BorderSpacing.Top = 4
         Constraints.MaxWidth = 300
         TabOrder = 1
-        Text = '192.168.  0.254'
       end
       object panScanButtons: TPanel
         Left = 0
@@ -211,7 +211,6 @@ object frmMain: TfrmMain
         BorderSpacing.Top = 4
         Constraints.MaxWidth = 300
         TabOrder = 0
-        Text = '127.  0.  0.  1'
       end
       object memPingLog: TMemo
         Left = 4
@@ -229,17 +228,62 @@ object frmMain: TfrmMain
       Caption = '&Trace Route'
       ClientHeight = 469
       ClientWidth = 790
-      object Panel2: TPanel
+      object lblTraceHost: TLabel
+        Left = 4
+        Height = 17
+        Top = 4
+        Width = 786
+        Align = alTop
+        BorderSpacing.Left = 4
+        BorderSpacing.Top = 4
+        Caption = 'Host to Ping'
+      end
+      object edtTraceHost: TIPEdit
+        Left = 4
+        Height = 34
+        Top = 25
+        Width = 300
+        Align = alTop
+        BorderSpacing.Left = 4
+        BorderSpacing.Top = 4
+        Constraints.MaxWidth = 300
+        TabOrder = 0
+      end
+      object panTraceButtons: TPanel
         Left = 0
-        Height = 469
-        Top = 0
+        Height = 37
+        Top = 59
         Width = 790
+        Align = alTop
+        AutoSize = True
+        BevelOuter = bvNone
+        ClientHeight = 37
+        ClientWidth = 790
+        TabOrder = 1
+        object btnTraceStart: TButton
+          Left = 4
+          Height = 33
+          Top = 4
+          Width = 133
+          Action = actTraceStart
+          Align = alLeft
+          AutoSize = True
+          BorderSpacing.Left = 4
+          BorderSpacing.Top = 4
+          Constraints.MinWidth = 100
+          TabOrder = 0
+        end
+      end
+      object memTraceLog: TMemo
+        Left = 4
+        Height = 365
+        Top = 100
+        Width = 782
         Align = alClient
-        Caption = 'Not Implemented yet'
-        Font.Height = -40
-        Font.Style = [fsBold]
-        ParentFont = False
-        TabOrder = 0
+        BorderSpacing.Around = 4
+        ReadOnly = True
+        ScrollBars = ssAutoVertical
+        TabOrder = 2
       end
     end
   end
@@ -272,6 +316,11 @@ object frmMain: TfrmMain
       Caption = 'Start Ping'
       OnExecute = actPingStartExecute
     end
+    object actTraceStart: TAction
+      Category = 'Trace'
+      Caption = 'Start Trace Route'
+      OnExecute = actTraceStartExecute
+    end
   end
   object mmMain: TMainMenu
     Left = 448

src/forms/forms.main.pas

@@ -22,30 +22,35 @@ interface
   { TfrmMain }
 
   TfrmMain = class(TForm)
+    actTraceStart: TAction;
     actPingStart: TAction;
     actScanStop: TAction;
     actMyIPFetch: TAction;
     actScanStart: TAction;
     alMain: TActionList;
     actFileExit: TFileExit;
+    btnTraceStart: TButton;
     btnScanStart: TButton;
     btnMyIpFetch: TButton;
     btnScanStop: TButton;
     btnPingStart: TButton;
-    edtStartIP: TIPEdit;
-    edtEndIP: TIPEdit;
+    edtTraceHost: TIPEdit;
+    edtScanStartIP: TIPEdit;
+    edtScanEndIP: TIPEdit;
     edtPingHost: TIPEdit;
     ipsMain: TIniPropStorage;
     lblPingHost: TLabel;
+    lblTraceHost: TLabel;
     memMyIPLog: TMemo;
     memPingLog: TMemo;
+    memTraceLog: TMemo;
     panPingButtons: TPanel;
-    Panel2: TPanel;
     panMyIPButtons: TPanel;
+    panTraceButtons: TPanel;
     tsMyIP: TTabSheet;
     vstScan: TLazVirtualStringTree;
-    lblStartIP: TLabel;
-    lblEndIP: TLabel;
+    lblScanStartIP: TLabel;
+    lblScanEndIP: TLabel;
     mnuFile: TMenuItem;
     mnuFileExit: TMenuItem;
     mmMain: TMainMenu;
@@ -55,18 +60,21 @@   TfrmMain = class(TForm)
     tsPing: TTabSheet;
     tsScan: TTabSheet;
     procedure actMyIPFetchExecute(Sender: TObject);
-    procedure actPingStartExecute(Sender: TObject);
     procedure actScanStartExecute(Sender: TObject);
     procedure actScanStopExecute(Sender: TObject);
+    procedure actPingStartExecute(Sender: TObject);
+    procedure actTraceStartExecute(Sender: TObject);
     procedure alMainUpdate(AAction: TBasicAction; var Handled: Boolean);
     procedure FormCreate(Sender: TObject);
+    procedure FormShow(Sender: TObject);
     procedure FormDestroy(Sender: TObject);
 
     procedure EnablePropertyStorage;
     procedure DisablePropertyStorage;
     procedure InitShortcuts;
     procedure EnableControls;
     procedure DisableControls;
+    procedure pcMainChange(Sender: TObject);
   private
 
   public
@@ -81,6 +89,7 @@ implementation
 uses
   LCLType
 , fphttpclient
+, blcksock
 , pingsend
 ;
 
@@ -101,11 +110,29 @@ implementation
 procedure TfrmMain.FormCreate(Sender: TObject);
 begin
   Caption:= Format('%s v%s', [ Application.Title, cVersion ]);
-  pcMain.ActivePageIndex:= 0;
+  if pcMain.ActivePageIndex <> 0 then pcMain.ActivePageIndex:= 0;
   EnablePropertyStorage;
   InitShortcuts;
 end;
 
+procedure TfrmMain.FormShow(Sender: TObject);
+begin
+  case pcMain.ActivePageIndex of
+    0:begin // MyIP
+      // Do Nothing
+    end;
+    1:begin // Scan
+      edtScanStartIP.SetFocus;
+    end;
+    2:begin // Ping
+      edtPingHost.SetFocus;
+    end;
+    3:begin // Trate Route
+      edtTraceHost.SetFocus;
+    end;
+  end;
+end;
+
 procedure TfrmMain.FormDestroy(Sender: TObject);
 begin
   DisablePropertyStorage;
@@ -150,6 +177,11 @@ procedure TfrmMain.DisableControls;
   pcMain.Enabled:= False;
 end;
 
+procedure TfrmMain.pcMainChange(Sender: TObject);
+begin
+
+end;
+
 procedure TfrmMain.alMainUpdate(AAction: TBasicAction; var Handled: Boolean);
 begin
   if AAction = actScanStop then
@@ -206,6 +238,22 @@ procedure TfrmMain.actMyIPFetchExecute(Sender: TObject);
   EnableControls;
 end;
 
+procedure TfrmMain.actScanStartExecute(Sender: TObject);
+begin
+  actScanStart.Enabled:= False;
+  Application.ProcessMessages;
+
+  ShowMessage('Not Implemented yet.');
+
+  Application.ProcessMessages;
+  actScanStart.Enabled:= True;
+end;
+
+procedure TfrmMain.actScanStopExecute(Sender: TObject);
+begin
+  //
+end;
+
 procedure TfrmMain.actPingStartExecute(Sender: TObject);
 var
   pingClient: TPINGSend;
@@ -243,20 +291,46 @@ procedure TfrmMain.actPingStartExecute(Sender: TObject);
   EnableControls;
 end;
 
-procedure TfrmMain.actScanStartExecute(Sender: TObject);
+procedure TfrmMain.actTraceStartExecute(Sender: TObject);
+var
+  traceClient: TPINGSend;
+  ttl: byte;
 begin
-  actScanStart.Enabled:= False;
+  DisableControls;
   Application.ProcessMessages;
 
-  ShowMessage('Not Implemented yet.');
-
+  memTraceLog.Append(Format('Will now Trace Route "%s" (Max 29 Hops)', [ edtTraceHost.TextTrimmed ]));
   Application.ProcessMessages;
-  actScanStart.Enabled:= True;
-end;
 
-procedure TfrmMain.actScanStopExecute(Sender: TObject);
-begin
-  //
+  traceClient:= TPINGSend.Create;
+  try
+    ttl:= 1;
+    repeat
+      traceClient.TTL := ttl;
+      inc(ttl);
+      if ttl > 30 then break;
+      if not traceClient.Ping(edtTraceHost.TextTrimmed) then
+      begin
+        memTraceLog.Append(Format('Hop %d "%s":  %s Timeout', [ Pred(ttl), cAnyHost, traceClient.ReplyFrom ]));
+        Application.ProcessMessages;
+        continue;
+      end;
+      if (traceClient.ReplyError <> IE_NoError) and
+         (traceClient.ReplyError <> IE_TTLExceed) then
+      begin
+        memTraceLog.Append(Format('Hop %d "%s": %s', [ Pred(ttl), traceClient.ReplyFrom,  traceClient.ReplyErrorDesc ]));
+        Application.ProcessMessages;
+        break;
+      end;
+      memTraceLog.Append(Format('Hop %d "%s": %d ms', [ Pred(ttl), traceClient.ReplyFrom,  traceClient.PingTime ]));
+      Application.ProcessMessages;
+    until traceClient.ReplyError = IE_NoError;
+  finally
+    traceClient.Free;
+  end;
+
+  Application.ProcessMessages;
+  EnableControls;
 end;
 
 end.