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	torben	2671	// 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.