Start Free Trial

asked on

Get the connection speed.

Hi.
I want to get the connection speed.
I found this code:

uses Registry

procedure TForm1.Button1Click(Sender: TObject);
var
Reg : TRegistry;
ConnectBuffer : array[0..3] of Byte;
ConnectSpeed : LongInt;
begin
Reg := TRegistry.Create;
with Reg do
begin
RootKey := HKEY_DYN_DATA;
if OpenKey('\PerfStats\StatData', False) then
begin
ReadBinaryData('Dial-Up Adapter\ConnectSpeed', ConnectBuffer, 4);
ConnectSpeed := LongInt(ConnectBuffer);
Label1.Caption := 'Connection Speed: ' + IntToStr(ConnectSpeed);
end;
end;
Reg.Free;
end;

-----------------------------------------------------------
This doesnt work coz probably there is no key like that in registry in WinXP.

Can someone supply a code?

Thanks in advance.

there was same question
https://www.experts-exchange.com/questions/21360930/Connection-Speed.html
Have You looked there?

mokule

ASKER

Hi mokule... and thank u but...

Link 1.) This is one of mine old questions ... irrelevant.. :)

Link 2.) You should use the RasGetConnectionStatistics(XP, 2000), RasGetLinkStatistics(CE) Api to read the RAS_STATS...
I dont want to use RAS if that is possible.

Link 3.) I dont want Components...

In my question i posted an answer that was probably for another version of windows (98 maybe)..
I want to use the registry.

Thanks.

ASKER

To be more clear...

I want to get the connection speed of the current connection.
Example :41.6 Kb/sec (Dial up).. etc

DavidBirch2dotCom

>Example :41.6 Kb/sec (Dial up).. etc
u mean kilobits ? if only dialup was that fast ;-)

have you seen https://www.experts-exchange.com/questions/21280857/Internet-Delphi.html ?

ASKER

:)

The link you gave me is one of my questions...
In that question i asked just for a monitor... When a packet goes in my PC--> Do something..
It has nothing to do with retrieving the speed..... 31.2Kbps [More realistic ;) ]

Hi again, try this code:

**** project file [ConnectionSpeed.dpr]

program ConnectionSpeed;

uses
Forms,
FMain in 'FMain.pas' {frmMAIN};

{$R *.res}

begin
Application.Initialize;
Application.CreateForm(TfrmMAIN, frmMAIN);
Application.Run;
end.

**** main form [FMain.pas]

unit FMain;

interface

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

type
TfrmMAIN = class(TForm)
labUPLOAD: TLabel;
timMAIN: TTimer;
labDOWNLOAD: TLabel;
procedure timMAINTimer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

const
MAX_ROWS=32;

type
TrIFROW=record
FName:array[0..511] of Byte; // interface caption
FIndex:Cardinal; // index of the interfaces
FType:Longint; // type of interface
FMTU:Longint; // max transmission unit
FSpeed:Longint; // speed of the interfaces
FPhysAddrLen:Longint; // length of physical address
FPhysAddr:array[0..7] of Byte; // physical address of adapter
FAdminStatus:Longint; // administrative status
FOperStatus:Longint; // operational status
FLastChange:Longint; // read time operational status changed
FInOctets:Longint; // octets received
FInUcastPkts:Longint; // unicast packets received
FInNUcastPkts:Longint; // non unicast packets received
FInDiscards:Longint; // received packets discarded
FInErrors:Longint; // erroneous packets received
FInUnknownProtos:Longint; // unknown protocol packets received
FOutOctets:Longint; // octets sent
FOutUcastPkts:Longint; // unicast packets sent
FOutNUcastPkts:Longint; // non unicast packets sent
FOutDiscards:Longint; // outgoing packets discarded
FOutErrors:Longint; // erroneous packets sent
FOutQLen:Longint; // output queue length
FLength:Longint; // length of bDescr more member
FDescription:array[0..255] of Char; // interface description
end;

TrIFTABLE=record
FCount:LongInt; // number of interfaces
FRows:array[0..MAX_ROWS] of TrIFROW; // more than 20 should be it however!
end;

var
frmMAIN: TfrmMAIN;

function GetIfTable(pIfRowTable:Pointer;var pdwSize:Longint;dwCode:Longint):Longint;stdcall;external 'IPHlpAPI.dll' name 'GetIfTable';

implementation

{$R *.dfm}

const
FirstRun:Boolean=True;
LastUL:Integer=0;
LastDL:Integer=0;

procedure TfrmMAIN.timMAINTimer(Sender: TObject);
var
Table:TrIFTABLE;
Error:DWORD;
Size:Longint;
begin
Error:=GetIfTable(@Table,Size,1);
Error:=GetIfTable(@Table,Size,1);
if not FirstRun then
begin
labUPLOAD.Caption:='Upload speed: '+FloatToStrF((Table.FRows[1].FOutOctets-LastUL)/1024,ffFixed,10,2)+' kB/s';
labDOWNLOAD.Caption:='Download speed: '+FloatToStrF((Table.FRows[1].FInOctets-LastDL)/1024,ffFixed,10,2)+' kB/s';
end else FirstRun:=False;
LastUL:=Table.FRows[1].FOutOctets;
LastDL:=Table.FRows[1].FInOctets;
end;

end.

**** main form [FMain.dfm]

object frmMAIN: TfrmMAIN
Left = 426
Top = 331
Width = 162
Height = 74
BorderIcons = [biSystemMenu]
Caption = ' CONNECTION SPEED'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
Position = poDesktopCenter
PixelsPerInch = 96
TextHeight = 13
object labUPLOAD: TLabel
Left = 20
Top = 8
Width = 69
Height = 13
Caption = 'Upload speed:'
end
object labDOWNLOAD: TLabel
Left = 6
Top = 27
Width = 83
Height = 13
Caption = 'Download speed:'
end
object timMAIN: TTimer
OnTimer = timMAINTimer
Left = 122
Top = 10
end
end

regards,
Kate

Just a note:

Maybe you'll have to change Table.FRows[1] index
to interface your internet connection is setup on.
Usually it's by this scheme:

0: Loopback 127.0.0.1
1: Network card

so it should work anyway :)

regards,
Kate

ASKER

Hi Katka :) :) :)

Thank u very much...
This is more than i asked !! :)

Well again i have problems in compiling :/ :)

FirstRun, LastUL, LastDL : Undeclared identifiers...

What type of variable this values use ?

Thanks..

Hi, here they are:

const
FirstRun:Boolean=True;
LastUL:Integer=0;
LastDL:Integer=0;

maybe you have to switch "Assignable typed constants" on
and "Strict var-strings" off in compiler project options.

regards,
Kate

ASKER

Hi Katka.

Did what u said.
Now its working... But the results are not right...

Download time take only these 2 values -9027.96 and 9027.9 kb/sec
and upload always at 0.12 kb/sec
...Most of the times is 0...

:/ Any suggestions...?
Increasing the points...

ASKER

Changed Table.FRows[1] index but the numbers are huge
download : 35454545454 something like that... and upload stays negative.

Wierd works fine for me. Well.. First of all,
take a look at Error variable if the second
one (GetIfTable) is returning zero. If yeah
then look at the structure returned. It has
to have names inside in a FDescription
field. Set the X in Table.FRows[X] to where
you find your network card. If Error is non
zero or the Table structure is not returning
any results. Type here what version of
Delphi and Windows are you using.

regards,
Kate

ASKER

XP Pro SP2, Delphi 7 Enterprise .

So far i did :
Table.FRows[0] and
Table.FRows[1]

Well I've got XP Pro SP2 and Delphi 7 Ent :)
So this shouldn't be problem.. Is GetIfTable
returning zero and Table is filled with data ?

And one more don't you have some kind
of special network configuration like two
network cards or more local networks or
even alternative IP settings under one of
them ?

Because standartly it has to return:

Table.FRows[0].FDescription -> MS TCP Loopback interface
Table.FRows[1].FDescription -> Realtek RTL8139 Family PCI Fast Ethernet NIC, Packet Scheduler Miniport // in my case

Got to go to party..write all the information I've
requested and all the informations you'll find
important and I'll handle it later :) but anyways
it's wierd I'd try it on six different computers
and it works seamlessly..the only problem may
be in network configuration..make sure the
index matches the FDescription name of your
network card and also take a look at FCount
of interfaces because it also may be FRows[2]
or more :))

bye now,
Kate

ASKER

Error get the value 87 :/

ASKER

ooh and have a good time :))

ASKER

Some info :/

Label1.Caption:= FloatToStR(Error);
----> Error=87
-----------------------------------------------------------------------

labUPLOAD.Caption:=
'Upload speed: '
+FloatToStrF
((Table.FRows[1].FOutOctets-LastUL)/1024,ffFixed,10,2)
+' kB/s';

labDOWNLOAD.Caption:=
'Download speed: '
+FloatToStrF((Table.FRows[1].FInOctets-LastDL)/1024,ffFixed,10,2)
+' kB/s';

Changed Table.FRows[X] where X tried 0,1,2,3,4

-----------------------------------------------------------------------
The timer interval should be 1000 ?
-----------------------------------------------------------------------
IPHlpAPI.dll version ---> 5.1.2600.2180

1 External modem 56k, 1 Ethernet adapter...

Well, no it's clear you're getting
Error 87 which means: ERROR_INVALID_PARAMETER
so the data in Table are not valid
at all. Please check the lines:

Error:=GetIfTable(@Table,Size,1);
Error:=GetIfTable(@Table,Size,1);

and tell me both values of Error and
Size and also check if @Table is valid.
Because when we'll achieve the values:

Error:=GetIfTable(@Table,Size,1); >> 122
Error:=GetIfTable(@Table,Size,1); >> 0

We won. Otherwise setup the options of project
like this:

http://www.volny.cz/genocide/Options.png

regards,
Kate

ASKER

:/
Thank you for your patience.. Forgive me if i stupidly do something wrong...
I'll post all the info i can ...to clear some things & to avoid any confusion...

-------------------------------------------------------------------------------------

unit Unit1;

interface

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

type
TForm1 = class(TForm)
labUPLOAD: TLabel;
timMAIN: TTimer;
labDOWNLOAD: TLabel;
Label1: TLabel;
Label2: TLabel;
procedure timMAINTimer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
const
MAX_ROWS=32;

type
TrIFROW=record
FName:array[0..511] of Byte; // interface caption
FIndex:Cardinal; // index of the interfaces
FType:Longint; // type of interface
FMTU:Longint; // max transmission unit
FSpeed:Longint; // speed of the interfaces
FPhysAddrLen:Longint; // length of physical address
FPhysAddr:array[0..7] of Byte; // physical address of adapter
FAdminStatus:Longint; // administrative status
FOperStatus:Longint; // operational status
FLastChange:Longint; // read time operational status changed
FInOctets:Longint; // octets received
FInUcastPkts:Longint; // unicast packets received
FInNUcastPkts:Longint; // non unicast packets received
FInDiscards:Longint; // received packets discarded
FInErrors:Longint; // erroneous packets received
FInUnknownProtos:Longint; // unknown protocol packets received
FOutOctets:Longint; // octets sent
FOutUcastPkts:Longint; // unicast packets sent
FOutNUcastPkts:Longint; // non unicast packets sent
FOutDiscards:Longint; // outgoing packets discarded
FOutErrors:Longint; // erroneous packets sent
FOutQLen:Longint; // output queue length
FLength:Longint; // length of bDescr more member
FDescription:array[0..255] of Char; // interface description
end;

TrIFTABLE=record
FCount:LongInt; // number of interfaces
FRows:array[0..MAX_ROWS] of TrIFROW; // more than 20 should be it however!
end;

var
Form1: TForm1;

function GetIfTable(pIfRowTable:Pointer;
var pdwSize:Longint;dwCode:Longint):Longint;stdcall;
external 'IPHlpAPI.dll' name 'GetIfTable';

implementation

{$R *.dfm}

const
FirstRun:Boolean=True;
LastUL:Integer=0;
LastDL:Integer=0;

procedure TForm1.timMAINTimer(Sender: TObject);
var
Table:TrIFTABLE;
Error:DWORD;
Size:Longint;
begin
Error:=GetIfTable(@Table,Size,1);
Error:=GetIfTable(@Table,Size,1);

Label1.Caption:= FloatToStR(Error); // Check for Error value
Label2.Caption:= FloatToStR(Size); // Check for size value

if not FirstRun then
begin

labUPLOAD.Caption:=
'Upload speed: '
+FloatToStrF
((Table.FRows[1].FOutOctets-LastUL)/1024,ffFixed,10,2)
+' kB/s';

labDOWNLOAD.Caption:=
'Download speed: '
+FloatToStrF((Table.FRows[1].FInOctets-LastDL)/1024,ffFixed,10,2)
+' kB/s';

end else FirstRun:=False;

LastUL:=Table.FRows[13].FOutOctets; // At this points i put values..1-32 :/
LastDL:=Table.FRows[13].FInOctets;
end;

end.

-------------------------------------------------------------------------------------
Is that ok ?
The value for size is always 10559152
The value for error is always 87
Did a check until "Violation of subrange bounds"..

Hi, ok the options are quickly vanishing :(
I have few more opinions, I presume
that you meant the Error is 87 at both lines.
So, let's go:

1) check in Evaluator the Table variable
if shows data (zeros) on the first line
2) check the Table.FCount variable after
first Error:=GetIfTable(@Table,Size,1)
run and post it
3) check Table.FRows[x].FDescription
after the first and second call to GetIfTable
is made and check if they're valid (IMO
they shouldn't be)
4) increase the MAX_ROWS to let's say 255
5) if they're some valid data in Table after
first or second call (I doubt that) ensure
yourself that you changed Table.FRows[X]
X everywhere

awaiting your comments,
Kate

ASKER

Yes the error was 87 for the two lines... will repost later when i check the above.. :)
BTW Would it be easier if i only get the speed of the net without the upload - download speed ? :/

Example
"Current connection speed: 40kbps" ...

ASKER

1---> Hmmm dont know how to do that..
2.) Table.Fcount after first line = 0, after second = 0.
But when there is "movement" in up-down changes always to = 1022164
3.---> Cant do that... How ?
4.) Ok
5) ok

Something has occured to me..Try changing this segment:

function GetIfTable(pIfRowTable:Pointer;var pdwSize:Longint;dwCode:Longint):Longint;stdcall;external 'IPHlpAPI.dll' name 'GetIfTable';

implementation

{$R *.dfm}

const
FirstRun:Boolean=True;
LastUL:Integer=0;
LastDL:Integer=0;

procedure TfrmMAIN.timMAINTimer(Sender: TObject);
var
Table:TrIFTABLE;
Error:DWORD;
Size:Longint;
begin
Error:=GetIfTable(@Table,Size,1);
Error:=GetIfTable(@Table,Size,1);

----- into this one:

function GetIfTable(pIfRowTable:Pointer;var pdwSize:ULONG;dwCode:BOOL):DWORD;stdcall;external 'IPHlpAPI.dll' name 'GetIfTable';

implementation

{$R *.dfm}

const
FirstRun:Boolean=True;
LastUL:Integer=0;
LastDL:Integer=0;

procedure TfrmMAIN.timMAINTimer(Sender: TObject);
var
Table:TrIFTABLE;
Error:DWORD;
Size:ULONG;
begin
Error:=GetIfTable(nil,Size,True);
Error:=GetIfTable(@Table,Size,True);
------------

otherwise here's how to accomplish points 1) and 3)

1) set breakpoint at line (F5) -> Error:=GetIfTable(@Table,Size,True);
run the program (F9)
after it stops on breakpoint start evaluator (Ctrl-F7)
enter the "Table" and press enter
2) same as previous only enter Table.FRows[1].FDescription into the Evaluator
you can do both steps in one pass

Kate

Getting connection speed is possible only thru RAS
or PerfStats in registry (Windows 98 and below).
The only accurate way is thru the system API and
that's the way we're heading. But still I'm confused
why it's not functional for you..may you please
download my compiled binary to checked whether
it's not by compiler.

http://www.volny.cz/genocide/ConnectionSpeed.exe

it's syntax goes like: ConnectionSpeed.exe <interface number to watch>
try "ConnectionSpeed.exe 1" or 2 and so on..

Kate

ASKER

Kate did what u said the results are :

1) Table is full of zeros for FCount 0
i changed the value of FCount until 16 but FROWS are full of zeros.
2.) For the 255 Data values ----> all #0.

:) Thanks for ur time :)

ASKER

File not found... following the link ... :/

I'm able to download it by click perfectly.
Try it once again maybe it was still in
upload while you're trying. :)

ASKER

Downloading :)

Don't forget the parameter. It should print out
the names of interfaces into the listbox and
detect speed as usual. Try even zero because
it's loopback which is in Windows by default.

It should run something like: http://www.volny.cz/genocide/Running.png :)

ASKER

:@

Several access violation at memory module.

That's fine..by now we've eliminated anything
caused by language because the very same
copy is working in my place. Do you have any
chance to test it on a different machine.

(at your second computer or by friend)

Because I'm suspecting the modem for this
misbehaviour. But this shouldn't be.

regards,
Kate

ASKER

Ok i'll check it... be back in 5. :)

ASKER

Ok...

Try it in my laptop..
I m glad to report that my modem is ok :) .... the results are the same at the laptop.
I really dont know what could be the fault...

ASKER

I'll give it a try in another pc... :/

Can u please take a look at my code?
Its just the source.
http://www.geocities.com/kalatz_gr_fisher/TheFiles/speed.zip

ASKER CERTIFIED SOLUTION

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

ASKER

:)

Good news... I think. :)

Now the :
Label1.Caption:= FloatToStR(Table.FCount);
Label2.Caption:= FloatToStR(Table.FCount);

Give 3 as result... and the upload and download freezeat zero ... I replaced

:) :) :) :) :) :)

I replaced it with 2.... Its working now....
Thank you very very very much :)

I appreciate very much the time and effort u spend :).....

Btw i'll post another thread for just getting the internet speed... LOL
If you want give me a hint about RAS... Thanks :)

In my opinion you should detect internet
providing interfaces and sum their speeds.

Type of interface is stored in Table.FRows[X].FType:

Ethernet = 6
Tokenring = 9
FDDI = 15
PPP = 23
Local loopback = 24
SLIP = 28

and from Table.FRows[X].FOperStatus determine connection status:

NON_OPERATIONAL = 0
UNREACHABLE = 1
DISCONNECTED = 2
CONNECTING = 3
CONNECTED = 4
OPERATIONAL = 5

IMO anyway you should simply do something like:

Speed:=0; for A:=1 to 2 do Inc(Speed,Table.FRows[A].FInOctets+Table.FRows[A].FOutOctets);

to gather overall connection speed :)

regards,
Kate

ASKER

Pls copy-paste your answer to my new question.
Thanks :)