Get the server (router) and client IP address of your dial up connection

Problem/Question/Abstract:

There are quite a lot of articles on retrieving IP addresses for LAN interfaces. Here's one for dialup using RAS(Remote Access Services). Note that it requires header files which are available from Delphi JEDI site

Answer:

Please note that the program uses ras.pas and other header files which are available in the API library of delphi jedi site. The complete project having all the header files is being provided to the webmaster for update.

It displays the server and client IP every second on a label.

unit uMain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls;

type
  TfrmMain = class(TForm)
    lblIP: TLabel;
    tmrUpdate: TTimer;
    procedure tmrUpdateTimer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

uses Ras, RasError;

{$R *.DFM}

procedure GetDialUpIpAddress(var server, client: string);
var
  RASPppIp: RASIP;
  lpcp: DWORD;
  ConnClientIP: array[0..RAS_MaxIpAddress] of Char;
  ConnServerIP: array[0..RAS_MaxIpAddress] of Char;

  Entries: PRasConn;
  BufSize, NumberOfEntries, Res: DWORD;
  RasConnHandle: THRasConn;
begin
  New(Entries);
  BufSize := Sizeof(Entries^);
  ZeroMemory(Entries, BufSize);
  Entries^.dwSize := Sizeof(Entries^);

  Res := RasEnumConnections(Entries, BufSize, NumberOfEntries);
  if Res = ERROR_BUFFER_TOO_SMALL then
  begin
    ReallocMem(Entries, BufSize);
    ZeroMemory(Entries, BufSize);
    Entries^.dwSize := Sizeof(Entries^);
    Res := RasEnumConnections(Entries, BufSize, NumberOfEntries);
  end;
  try
    if (Res = 0) and (NumberOfEntries > 0) then
      RasConnHandle := Entries.hrasconn
    else
      exit
  finally
    FreeMem(Entries);
  end;

  FillChar(RASPppIp, SizeOf(tagRASIP), 0);
  RASPppIp.dwSize := SizeOf(tagRASIP);
  lpcp := RASPppIp.dwSize;
  if RasGetProjectionInfo(RasConnHandle,
    RASP_PppIp, @RasPppIp, lpcp) = 0 then
  begin

    Move(RASPppIp.szServerIpAddress,
      ConnServerIP,
      SizeOf(ConnServerIP));
    Server := ConnServerIP;
    Move(RASPppIp.szIpAddress,
      ConnClientIP,
      SizeOf(ConnClientIP));
    client := ConnClientIP;
  end;
end;

procedure TfrmMain.tmrUpdateTimer(Sender: TObject);
var
  ConnServerIP, ConnClientIP: string;
begin
  GetDialUpIpAddress(ConnServerIP, ConnClientIP);
  if ConnServerIP = '' then
    ConnServerIP := 'NA';
  if ConnClientIP = '' then
    ConnClientIP := 'NA';
  lblIP.Caption := Format('Server : %s'#13#10'Client   : %s', [ConnServerIP,
    ConnClientIP])
end;