unit1.pas

用Delphi实现的网络测速 用Delphi实现的网络测速

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, OleCtrls, SHDocVw,mshtml, ComCtrls, Buttons, ExtCtrls,shellapi;

type
  TForm1 = class(TForm)
    StatusBar1: TStatusBar;
    GroupBox1: TGroupBox;
    WebBrowser1: TWebBrowser;
    Memo1: TMemo;
    Memo2: TMemo;
    GroupBox2: TGroupBox;
    WebBrowser2: TWebBrowser;
    ComboBox1: TComboBox;
    ProgressBar1: TProgressBar;
    SpeedButton1: TSpeedButton;
    GroupBox3: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Edit1: TEdit;
    GroupBox4: TGroupBox;
    Panel1: TPanel;
    GroupBox5: TGroupBox;
    Label3: TLabel;
    Label6: TLabel;
    procedure ComboBox1Change(Sender: TObject);
    procedure WebBrowser2DownloadComplete(Sender: TObject);
    procedure WebBrowser2DownloadBegin(Sender: TObject);
    procedure WebBrowser2ProgressChange(Sender: TObject; Progress,
      ProgressMax: Integer);
    procedure SpeedButton1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ComboBox1DropDown(Sender: TObject);
    procedure Label6Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
{$R gif.res}

function Extractres(restype,resname,newname:string):string;
var
 Res:TResourcestream;
begin
 try
  Res:=Tresourcestream.Create(Hinstance,resname,pchar(restype));
  Res.SaveToFile(newname);
 finally
  freeandnil(Res);
 end;
end;
procedure CS(UID:integer);
begin
 with Form1 do
  webbrowser2.Navigate('http://www.linkwan.com/gb/broadmeter/SpeedAuto/gotoSpeed.asp?SpeedUserId='+inttostr(UID));
end;

procedure TForm1.ComboBox1Change(Sender: TObject);
begin
try
  speedbutton1.Enabled:=false;
  statusbar1.Panels[0].Text:='连接测试服务器...';  
if combobox1.Text='惠州' then
   CS(29940) else
if combobox1.Text='广州' then
   CS(17853) else
if combobox1.Text='上海' then
   CS(547) else
if combobox1.Text='北京' then
   CS(32188) else
if combobox1.Text='东莞' then
   CS(45982) else
if combobox1.Text='天津' then
   CS(17523) else
if combobox1.Text='香港' then
   CS(5963) else
if combobox1.Text='重庆' then
   CS(2483) else
if combobox1.Text='台北' then
   CS(37797) else
if combobox1.Text='东京' then
   CS(25052) else
if combobox1.Text='美国' then
   CS(41495)
except
end;
end;

procedure TForm1.WebBrowser2DownloadComplete(Sender: TObject);
var
 i:integer;
begin
try
 if webbrowser2.LocationURL='http://www.linkwan.com/gb/broadmeter/SpeedAuto/Show.asp' then
  begin
   memo1.Clear;
   memo1.Lines.Add(IHTMLDOcument2(webbrowser2.Document).body.outerHTML);
  memo2.Clear;
  memo2.Lines.Add(copy(memo1.Lines.Text,pos('<TD width="33%">',memo1.Lines.Text),pos('<TD align=right width="34%">',memo1.Lines.Text)-pos('<TD width="33%">',memo1.Lines.Text)));
  for i:=0 to memo1.Lines.Count-1 do
   begin
    if pos('下载速度',memo1.Lines.Strings[i])>0 then
     begin
      memo2.Lines.Insert(0,memo1.Lines.Strings[i]);
      edit1.Text:=copy(memo1.Lines.Strings[i],pos('> <B>',memo1.Lines.Strings[i])+5,pos('.',memo1.Lines.Strings[i])-5-pos('> <B>',memo1.Lines.Strings[i]));
     end;
    if pos('IP：',memo1.Lines.Strings[i])>0 then
     label4.Caption:=copy(memo1.Lines.Strings[i],pos('IP：',memo1.Lines.Strings[i])+4,pos('</P>',memo1.Lines.Strings[i])-4-pos('IP：',memo1.Lines.Strings[i]));
    if pos('来自',memo1.Lines.Strings[i])>0 then
     label5.Caption:=copy(memo1.Lines.Strings[i],pos('008000>',memo1.Lines.Strings[i])+7,pos('</FONT>',memo1.Lines.Strings[i])-8-pos('#008000>',memo1.Lines.Strings[i]));
   end;
  memo2.Lines.SaveToFile('c:\temp\1.html');
  webbrowser1.Navigate('c:\temp\1.html');
  statusbar1.Panels[0].Text:='测试网速完毕';
  speedbutton1.Enabled:=true;
  i:=strtoint(edit1.Text);
//100以下太慢了，100-300比较慢，300-1000还行吧，1000-3000，速度很快，>3000 速度非常快
   if (i>0) and (i<=100) then
    begin
     panel1.Caption:='太慢了';
     panel1.Color:= clblack;
    end else
   if (i>100) and (i<=300) then
    begin
     panel1.Caption:='比较慢';
     panel1.Color:= clskyblue;
    end else
   if (i>300) and (i<=1000) then
    begin
     panel1.Caption:='还行吧';
     panel1.Color:= cllime;
    end else
   if (i>1000) and (i<=3000) then
    begin
     panel1.Caption:='速度很快';
     panel1.Color:= clGreen;
     panel1.Font.Color:= clcream;
    end else
   if i>=3000 then
    begin
     panel1.Caption:='速度非常快';
     panel1.Color:= clred;
     panel1.Font.Color:= clcream;
    end
  end;
except
end;
end;

procedure TForm1.WebBrowser2DownloadBegin(Sender: TObject);
begin
  webbrowser1.Navigate('about:blank');
  panel1.Caption:='';
  panel1.Color:= clBtnFace;
  panel1.Font.Color:= clblack;
  speedbutton1.Enabled:=false;
  statusbar1.Panels[0].Text:='开始测试网速['+combobox1.Text+']，请稍候...';
end;

procedure TForm1.WebBrowser2ProgressChange(Sender: TObject; Progress,
  ProgressMax: Integer);
begin
  progressbar1.Max:=progressmax;
  progressbar1.Position:=progress;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
  combobox1.OnChange(self);
end;

procedure TForm1.FormCreate(Sender: TObject);
var
 s:string;
begin
try
  s:='c:\temp\images\';
  Forcedirectories('c:\temp\images\');
  Extractres('gif','speedpic1',s+'speedpic1.gif');
  Extractres('gif','speedpic2',s+'speedpic2.gif');
  Extractres('gif','speedpic3',s+'speedpic3.gif');
  Extractres('gif','speedpic4',s+'speedpic4.gif');
  Extractres('gif','speedpic5',s+'speedpic5.gif');
  Extractres('gif','speedpic6',s+'speedpic6.gif');
  Extractres('gif','speedpic7',s+'speedpic7.gif');
  Extractres('gif','speedpic8',s+'speedpic8.gif');
except
end;  
end;



procedure TForm1.ComboBox1DropDown(Sender: TObject);
begin
  webbrowser1.Navigate('about:blank');
end;

procedure TForm1.Label6Click(Sender: TObject);
begin
 shellexecute(handle,'open','http://linkwan.com/gb/broadmeter/SpeedAuto/',nil,nil,sw_show);
end;

end.