tpsystools_4.04/source/StNetPfm.pas

// Upgraded to Delphi 2009: Sebastian Zierer

(* ***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is TurboPower SysTools
 *
 * The Initial Developer of the Original Code is
 * TurboPower Software
 *
 * Portions created by the Initial Developer are Copyright (C) 1996-2002
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

{*********************************************************}
{* SysTools: StNetPfm.pas 4.04                           *}
{*********************************************************}
{* SysTools: Net Performance Class                       *}
{*********************************************************}

{$I StDefine.inc}

{$H+} {Huge strings}

unit StNetPfm;

interface

uses
  Windows, Classes, StBase;

type
  TStCPFlags = (cpfForNetCard, cpfNotRouted, cpfSlowLink, cpfDynamic);
  TStCPFlagsSet = set of TStCPFlags;

  TStNetPerformance = class(TStComponent)
   private   { Private Methods/Properties   }
    FGotData     : Boolean;

    { Input }
    FLocalName   : string;
    FRemoteName  : string;
    FProviderName: string;

    { Output }
    FFlags       : TStCPFlagsSet;
    FSpeed       : DWord;
    FDelay       : DWord;
    FOptDataSize : DWord;
   protected { Protected Methods/Properties }
    function GetFlags: TStCPFlagsSet;
    function GetSpeed: DWord;
    function GetDelay: DWord;
    function GetOptDataSize : DWord;

    procedure SetLocalName(Value: string);
    procedure SetRemoteName(Value: string);
    procedure SetProviderName(Value: string);
   public    { Public Methods/Properties    }
    procedure QueryPerformance;

    property Flags: TStCPFlagsSet read GetFlags;
    property Speed: DWord read GetSpeed;
    property Delay: DWord read GetDelay;
    property OptDataSize: DWord read GetOptDataSize;

   published { Published Methods/Properties }
    property LocalName: string
      read FLocalName write SetLocalName;
    property RemoteName: string
      read FRemoteName write SetRemoteName;
    property ProviderName: string
      read FProviderName write SetProviderName;
  end;


implementation

uses
  SysUtils;

procedure TStNetPerformance.QueryPerformance;
var
  Err : DWord;
  NR  : TNetResource;
  CI  : TNetConnectInfoStruct;
begin
  FillChar(NR, SizeOf(NR), 0);
  FillChar(CI, SizeOf(CI), 0);

  if FLocalName <> '' then
    NR.lpLocalName := PChar(FLocalName)
  else
    NR.lpRemoteName := PChar(FRemoteName);

  if Length(FProviderName) > 0 then
    NR.lpProvider := PChar(FProviderName);

  CI.cbStructure := SizeOf(CI);

  Err := MultinetGetConnectionPerformance(@NR, @CI);
  if Err = NO_ERROR then begin
    FFlags := [];
    if (CI.dwFlags and WNCON_FORNETCARD) = WNCON_FORNETCARD then
      Include(FFlags, cpfForNetCard);
    if (CI.dwFlags and WNCON_NOTROUTED) = WNCON_NOTROUTED then
      Include(FFlags, cpfNotRouted);
    if (CI.dwFlags and WNCON_SLOWLINK) = WNCON_SLOWLINK then
      Include(FFlags, cpfSlowLink);
    if (CI.dwFlags and WNCON_DYNAMIC) = WNCON_DYNAMIC then
      Include(FFlags, cpfDynamic);

    FSpeed       := CI.dwSpeed;
    FDelay       := CI.dwDelay;
    FOptDataSize := CI.dwOptDataSize;

    FGotData := True;
  end else
    RaiseStWin32Error(EStNetException, Err);
end;

function TStNetPerformance.GetFlags: TStCPFlagsSet;
begin
  if not FGotData then
    QueryPerformance;
  Result := FFlags;
end;

function TStNetPerformance.GetSpeed: DWord;
begin
  if not FGotData then
    QueryPerformance;
  Result := FSpeed;
end;

function TStNetPerformance.GetDelay: DWord;
begin
  if not FGotData then
    QueryPerformance;
  Result := FDelay;
end;

function TStNetPerformance.GetOptDataSize : DWord;
begin
  if not FGotData then
    QueryPerformance;
  Result := FOptDataSize;
end;

procedure TStNetPerformance.SetLocalName(Value: string);
begin
  if Value <> FLocalName then begin
    FLocalName := Value;
    FGotData := False;
  end;
end;

procedure TStNetPerformance.SetRemoteName(Value: string);
begin
  if Value <> FRemoteName then begin
    FRemoteName := Value;
    FGotData := False;
  end;
end;

procedure TStNetPerformance.SetProviderName(Value: string);
begin
  if Value <> FProviderName then begin
    FProviderName := Value;
    FGotData := False;
  end;
end;


end.
1	// Upgraded to Delphi 2009: Sebastian Zierer
2
3	(* *** BEGIN LICENSE BLOCK ***
4	* Version: MPL 1.1
5	*
6	* The contents of this file are subject to the Mozilla Public License Version
7	* 1.1 (the "License"); you may not use this file except in compliance with
8	* the License. You may obtain a copy of the License at
9	* http://www.mozilla.org/MPL/
10	*
11	* Software distributed under the License is distributed on an "AS IS" basis,
12	* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
13	* for the specific language governing rights and limitations under the
14	* License.
15	*
16	* The Original Code is TurboPower SysTools
17	*
18	* The Initial Developer of the Original Code is
19	* TurboPower Software
20	*
21	* Portions created by the Initial Developer are Copyright (C) 1996-2002
22	* the Initial Developer. All Rights Reserved.
23	*
24	* Contributor(s):
25	*
26	* *** END LICENSE BLOCK *** *)
27
28	{*********************************************************}
29	{* SysTools: StNetPfm.pas 4.04 *}
30	{*********************************************************}
31	{* SysTools: Net Performance Class *}
32	{*********************************************************}
33
34	{$I StDefine.inc}
35
36	{$H+} {Huge strings}
37
38	unit StNetPfm;
39
40	interface
41
42	uses
43	Windows, Classes, StBase;
44
45	type
46	TStCPFlags = (cpfForNetCard, cpfNotRouted, cpfSlowLink, cpfDynamic);
47	TStCPFlagsSet = set of TStCPFlags;
48
49	TStNetPerformance = class(TStComponent)
50	private { Private Methods/Properties }
51	FGotData : Boolean;
52
53	{ Input }
54	FLocalName : string;
55	FRemoteName : string;
56	FProviderName: string;
57
58	{ Output }
59	FFlags : TStCPFlagsSet;
60	FSpeed : DWord;
61	FDelay : DWord;
62	FOptDataSize : DWord;
63	protected { Protected Methods/Properties }
64	function GetFlags: TStCPFlagsSet;
65	function GetSpeed: DWord;
66	function GetDelay: DWord;
67	function GetOptDataSize : DWord;
68
69	procedure SetLocalName(Value: string);
70	procedure SetRemoteName(Value: string);
71	procedure SetProviderName(Value: string);
72	public { Public Methods/Properties }
73	procedure QueryPerformance;
74
75	property Flags: TStCPFlagsSet read GetFlags;
76	property Speed: DWord read GetSpeed;
77	property Delay: DWord read GetDelay;
78	property OptDataSize: DWord read GetOptDataSize;
79
80	published { Published Methods/Properties }
81	property LocalName: string
82	read FLocalName write SetLocalName;
83	property RemoteName: string
84	read FRemoteName write SetRemoteName;
85	property ProviderName: string
86	read FProviderName write SetProviderName;
87	end;
88
89
90	implementation
91
92	uses
93	SysUtils;
94
95	procedure TStNetPerformance.QueryPerformance;
96	var
97	Err : DWord;
98	NR : TNetResource;
99	CI : TNetConnectInfoStruct;
100	begin
101	FillChar(NR, SizeOf(NR), 0);
102	FillChar(CI, SizeOf(CI), 0);
103
104	if FLocalName <> '' then
105	NR.lpLocalName := PChar(FLocalName)
106	else
107	NR.lpRemoteName := PChar(FRemoteName);
108
109	if Length(FProviderName) > 0 then
110	NR.lpProvider := PChar(FProviderName);
111
112	CI.cbStructure := SizeOf(CI);
113
114	Err := MultinetGetConnectionPerformance(@NR, @CI);
115	if Err = NO_ERROR then begin
116	FFlags := [];
117	if (CI.dwFlags and WNCON_FORNETCARD) = WNCON_FORNETCARD then
118	Include(FFlags, cpfForNetCard);
119	if (CI.dwFlags and WNCON_NOTROUTED) = WNCON_NOTROUTED then
120	Include(FFlags, cpfNotRouted);
121	if (CI.dwFlags and WNCON_SLOWLINK) = WNCON_SLOWLINK then
122	Include(FFlags, cpfSlowLink);
123	if (CI.dwFlags and WNCON_DYNAMIC) = WNCON_DYNAMIC then
124	Include(FFlags, cpfDynamic);
125
126	FSpeed := CI.dwSpeed;
127	FDelay := CI.dwDelay;
128	FOptDataSize := CI.dwOptDataSize;
129
130	FGotData := True;
131	end else
132	RaiseStWin32Error(EStNetException, Err);
133	end;
134
135	function TStNetPerformance.GetFlags: TStCPFlagsSet;
136	begin
137	if not FGotData then
138	QueryPerformance;
139	Result := FFlags;
140	end;
141
142	function TStNetPerformance.GetSpeed: DWord;
143	begin
144	if not FGotData then
145	QueryPerformance;
146	Result := FSpeed;
147	end;
148
149	function TStNetPerformance.GetDelay: DWord;
150	begin
151	if not FGotData then
152	QueryPerformance;
153	Result := FDelay;
154	end;
155
156	function TStNetPerformance.GetOptDataSize : DWord;
157	begin
158	if not FGotData then
159	QueryPerformance;
160	Result := FOptDataSize;
161	end;
162
163	procedure TStNetPerformance.SetLocalName(Value: string);
164	begin
165	if Value <> FLocalName then begin
166	FLocalName := Value;
167	FGotData := False;
168	end;
169	end;
170
171	procedure TStNetPerformance.SetRemoteName(Value: string);
172	begin
173	if Value <> FRemoteName then begin
174	FRemoteName := Value;
175	FGotData := False;
176	end;
177	end;
178
179	procedure TStNetPerformance.SetProviderName(Value: string);
180	begin
181	if Value <> FProviderName then begin
182	FProviderName := Value;
183	FGotData := False;
184	end;
185	end;
186
187
188	end.