unit1.~pas

可以在局域网内互发网络短消息； 为PING提供GUI界面 自动PING代理服务器

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls,jostudio_ip,inifiles, ExtCtrls, ComCtrls,jostudio_stringlist,
  jostudio_string, Buttons,jostudio_registry,Wininet,jostudio_ie;

type
  TFormDetect = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    editName1: TEdit;
    editName2: TEdit;
    editName3: TEdit;
    editIP1: TEdit;
    editIP2: TEdit;
    editIP3: TEdit;
    editResult1: TEdit;
    editResult2: TEdit;
    editResult3: TEdit;
    btnCheck: TButton;
    btnCancel: TButton;
    Timer1: TTimer;
    ComboToWho: TComboBox;
    Label8: TLabel;
    Memo1: TMemo;
    Label9: TLabel;
    btnSend: TButton;
    SpeedButton1: TSpeedButton;
    Label10: TLabel;
    TabSheet3: TTabSheet;
    IPList: TMemo;
    Panel1: TPanel;
    btnPingList: TSpeedButton;
    btnSort: TSpeedButton;
    btnClear: TSpeedButton;
    Label11: TLabel;
    LabelLink: TLabel;
    btnSetProxy: TButton;
    Label12: TLabel;
    editProxy: TEdit;
    btnClearProxy: TButton;
    Label13: TLabel;
    btnReadProxy: TButton;
    Label14: TLabel;
    Label15: TLabel;
    Label16: TLabel;
    CheckPort: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnCheckClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure btnSendClick(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure btnPingListClick(Sender: TObject);
    procedure btnClearClick(Sender: TObject);
    procedure btnSortClick(Sender: TObject);
    procedure LabelLinkClick(Sender: TObject);
    procedure btnSetProxyClick(Sender: TObject);
    procedure btnReadProxyClick(Sender: TObject);
    procedure btnClearProxyClick(Sender: TObject);
    procedure PageControl1Change(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FormDetect: TFormDetect;
  ini:TInifile;
  SettingFile:String;
  Canceled,first:boolean;

implementation

{$R *.DFM}

procedure TFormDetect.FormCreate(Sender: TObject);
begin
 SettingFile:=ExtractFilePath(Application.ExeName)+'网络工具配置文件.ini';
 ini:=TInifile.Create(SettingFile);
 editName1.text:=ini.ReadString('检测连通性','name1','');
 editName2.text:=ini.ReadString('检测连通性','name2','');
 editName3.text:=ini.ReadString('检测连通性','name3','');
 editIP1.text:=ini.ReadString('检测连通性','IP1','');
 editIP2.text:=ini.ReadString('检测连通性','IP2','');
 editIP3.text:=ini.ReadString('检测连通性','IP3','');
 ini.free;
 first:=true;
 if FileExists(SettingFile) then
 begin
   SectionReadFromFile(SettingFile,'地址',ComboToWho.Items);
   SectionReadFromFile(SettingFile,'IPList',IPList.Lines);
 end;
 btnReadProxyClick(Sender);   
end;

procedure TFormDetect.FormDestroy(Sender: TObject);
begin
 ini:=TInifile.Create(SettingFile);
 ini.WriteString('检测连通性','name1',editName1.text);
 ini.WriteString('检测连通性','name2',editName2.text);
 ini.WriteString('检测连通性','name3',editName3.text);
 ini.WriteString('检测连通性','IP1',editIP1.text);
 ini.WriteString('检测连通性','IP2',editIP2.text);
 ini.WriteString('检测连通性','IP3',editIP3.text);
 ini.free;
 SectionSaveToFile(SettingFile,'地址',ComboToWho.Items);
 SectionSaveToFile(SettingFile,'IPList',IPList.Lines);

 if ParamCount>0 then
 if ParamStr(1)='-proxy' then
 begin
    PageControl1.ActivePage:=TabSheet3;
    PageControl1Change(nil);
 end;   
end;

function ShowResult(n:Integer;IP:String):String;
begin
 if (n>=0) then
     Result:='连通!响应时间为'+IntToStr(n)+'毫秒'
 else
     Result:='无法连通:'+IP;
end;



procedure TFormDetect.btnCheckClick(Sender: TObject);
var
   ResultHostName,ResultIP:String;
begin
 Canceled:=false;btnCheck.Enabled:=Canceled;btnCancel.Enabled:=not btnCheck.Enabled;
 editResult1.Text:='';
 editResult2.Text:='';
 editResult3.Text:='';

 if editIP1.text<>'' then
    begin editResult1.Text:='正在检测...';Refresh; end;

 if editIP1.text<>'' then
    if IsIpAddress(editIP1.text) then
         editResult1.text:=ShowResult(Ping(editIP1.Text),editIP1.Text)
    else
         editResult1.text:=ShowResult(Ping2(editIP1.Text,ResultHostName,ResultIP),ResultIP);

 Application.Processmessages; if Canceled then exit;

 if editIP2.text<>'' then
    begin editResult2.Text:='正在检测...';Refresh;end;
 if editIP2.text<>'' then
     if IsIpAddress(editIP2.text) then
         editResult2.text:=ShowResult(Ping(editIP2.Text),editIP2.Text)
    else
         editResult2.text:=ShowResult(Ping2(editIP2.Text,ResultHostName,ResultIP),ResultIP);


 Application.Processmessages; if Canceled then exit;
 if editIP2.text<>'' then
    begin editResult3.Text:='正在检测...';Refresh; end;
 if editIP3.text<>'' then
     if IsIpAddress(editIP3.text) then
         editResult3.text:=ShowResult(Ping(editIP3.Text),editIP3.Text)
    else
         editResult3.text:=ShowResult(Ping2(editIP3.Text,ResultHostName,ResultIP),ResultIP);

 FormDestroy(nil);
 Canceled:=true;btnCheck.Enabled:=Canceled;btnCancel.Enabled:=not btnCheck.Enabled;
end;

procedure TFormDetect.Timer1Timer(Sender: TObject);
begin
 if first then
 begin
  timer1.enabled:=false;
  Refresh;
  Application.ProcessMessages;
  btnCheckClick(nil);
  first:=false;
 end;
end;

procedure TFormDetect.btnSendClick(Sender: TObject);
var
 ToWho,a,b,MessageContent:String;
 i:integer;
begin
  MessageContent:='';
  for i:=0 to Memo1.Lines.Count-1 do
  begin
     MessageContent:=MessageContent+chr(13)+Memo1.Lines.Strings[i];
  end;
  Split(ComboToWho.Text,'=',a,b);
  if b<>'' then ToWho:=b else ToWho:=a;

  if (a<>'') and (b<>'') then
  begin
       ComboToWho.Items.Values[a]:=b;
  end;
  
  //winexec(PChar('net send '+ToWho+' '+MessageContent),SW_HIDE);
  NetSendMessage(ToWho,MessageContent);

  Close;
end;

procedure TFormDetect.SpeedButton1Click(Sender: TObject);
var
 n:integer;
begin
  if ComboToWho.Text<>'' then
  begin
    n:=ComboToWho.Items.IndexOf(ComboToWho.Text);
    if n>=0 then
      ComboToWho.Items.Delete(n);
  end;
end;

//从一行文本中分析出IP地下，端口Port，和其它文字LineText。如果分析不成功，返回false.
function GetLineParam(Line:String;var IP,Port,LineText:String):boolean;
var
  s,s1:String;
  Delimiter:String;
  n,n1,n2:integer;
begin
  result:=false; n:=0;
  s:=Trim(Line);
  Delimiter:=' '; n1:=Pos(Delimiter,s);
  Delimiter:=':'; n2:=Pos(Delimiter,s);
  if (n1>0) then
  begin
    if (n2>0) and (n2<n1) then
      begin Delimiter:=':'; n:=n2;end
    else
      begin Delimiter:=' '; n:=n1;end;
  end
  else
  begin
    if n2>0 then begin Delimiter:=':'; n:=n2;end;
  end;  
  
  Split(s,Delimiter,IP,s1);s:=s1;
  Delimiter:=' '; n:=Pos(Delimiter,s);
  if n>=0 then
  begin
    Split(s,Delimiter,Port,s1);
    Port:=Trim(Port);
    if not IsNumberString(Trim(Port)) then Port:='' else s:=s1; 
  end;
  Delimiter:='||'; Split(s,Delimiter,LineText,s1);s:=s1;
  result:=true;
end;


procedure TFormDetect.btnPingListClick(Sender: TObject);
var
 i,n:integer;
 Line,IP,Port,LineText,sResult,TAB:String;
begin
 if btnPingList.Caption='中断' then
 begin
   Canceled:=true;
   exit;
 end;
 
 if btnPingList.Caption<>'试一遍' then exit;
 btnClearClick(Sender);
 btnPingList.Caption:='中断';Canceled:=false;Refresh;
 TAB:=chr(9);
 for i:=0 to IPList.Lines.Count-1 do
 begin
   Line:=IPList.Lines.Strings[i];
   Line:=Replace(Line,TAB,'');
   if Trim(Line)='' then break;
   if Canceled then break;   
   if GetLineParam(Line,IP,Port,LineText) then
   begin
     if IsIpAddress(IP) then
     begin
         n:=Ping(IP);
         if (n>=0) then
         begin
            if CheckPort then
            begin
              if ScanPort(IP,StrToInt(Port))=1 then
                sResult:='连通!'+IntToStr(n)+'毫秒'
              else
                sResult:='无法连通:'+IP+' 端口'+Port+'未开放。';
            end
            else
              sResult:='连通!'+IntToStr(n)+'毫秒';    
         end
         else
              sResult:='无法连通:'+IP;
         IPList.Lines.Strings[i]:=IP+':'+Port+TAB+' '+LineText+TAB+'||'+sResult;
     end;
     Refresh;
     Application.ProcessMessages;
   end;
 end;
 btnPingList.Caption:='试一遍';
end;

procedure TFormDetect.btnClearClick(Sender: TObject);
var
 i,n:integer;
 Line,IP,Port,LineText,sResult:String;
begin
 for i:=0 to IPList.Lines.Count-1 do
 begin
   Line:=IPList.Lines.Strings[i];
   Split(Line,'||',sResult,LineText);
   IPList.Lines.Strings[i]:=sResult;
 end;
end;

function SortByTime(List: TStringList; Index1, Index2: Integer): Integer;
var
  s1,s2,time1,time2:String;
  nTime1,nTime2:integer;
  function GetTime(s:String):String;
  var
    n1,n2:Integer;
  begin
    result:='';
    n1:=Pos('通!',s);
    n2:=Pos('毫秒',s);
    if (n1>0) and (n1<n2) then result:=Copy(s,n1+3,n2-n1-3);
  end;
begin
  s1:=List.Strings[index1];
  s2:=List.Strings[index2];
  time1:=GetTime(s1);
  time2:=GetTime(s2);
  result:=0;
  try
    nTime1:=StrToInt(Time1);
    nTime2:=StrToInt(Time2);
    if nTime1=nTime2 then exit;
    if nTime1<nTime2 then
      result:=-1
    else
      result:=1;
  except
  end;
end;

procedure TFormDetect.btnSortClick(Sender: TObject);
var
 i,n:integer;
 Line,IP,Port,LineText,sResult:String;
 ListOk,ListNo:TStringList;
begin
 //FormDetect.Caption:='0';
 ListOk:=TStringList.Create;
 ListNo:=TStringList.Create;
 for i:=0 to IPList.Lines.Count-1 do
 begin
   Line:=IPList.Lines.Strings[i];
   if Trim(Line)<>'' then
   begin
     if Pos('||连通',Line)>0 then
       ListOk.Add(Line)
     else
       ListNo.Add(Line);
   end;  
 end;
 IPList.Clear;
 Label11.Caption:=IntToStr(ListOk.Count);

 ListOK.CustomSort(SortByTime);

 IPList.Lines.AddStrings(ListOK);
 IPList.Lines.Add('');
 IPList.Lines.AddStrings(ListNo);
 ListOk.free;ListNo.free;
end;


procedure TFormDetect.LabelLinkClick(Sender: TObject);
begin
  Winexec(PChar('explorer.exe "'+TLabel(Sender).Caption+'"'),SW_SHOW);
end;


procedure TFormDetect.btnSetProxyClick(Sender: TObject);
var
  n:integer;
  Line,IP,Port,LineText,sResult:String;
begin
  n := SendMessage(IPList.Handle, EM_LINEFROMCHAR, IPList.SelStart, 0);
  if (n<0) or (n>IPList.Lines.Count-1) then
  begin
    ShowMessage('找不到当前行');
    exit;
  end;
  Line:=IPList.Lines.Strings[n];
  if GetLineParam(Line,IP,Port,LineText) then
  begin
    if SetProxySetting(IP,Port) then
    begin
      SetNetAntsProxySetting(IP,Port);
      ShowMessage('Proxy成功改为:'+IP+':'+Port)
    end
    else
      ShowMessage('Proxy修改不成功');
    btnReadProxyClick(Sender);  
  end
  else
  begin
    ShowMessage('找不到当前行的IP地址');
    exit;
  end;
end;

procedure TFormDetect.btnReadProxyClick(Sender: TObject);
var
  n:Integer;
  UsingProxy:Boolean;
  ProxyIP,Port:String;
begin
  if ReadProxySetting(UsingProxy,ProxyIP,Port) then
  begin
    if UsingProxy then
      editProxy.Text:=ProxyIP+':'+Port
    else
      editProxy.Text:='<直接连接,不使用代理>';
  end
  else
    editProxy.Text:='';
end;

procedure TFormDetect.btnClearProxyClick(Sender: TObject);
begin
  if not ClearProxySetting then ShowMessage ('清除代理设置失败');
  btnReadProxyClick(Sender);
end;

procedure TFormDetect.PageControl1Change(Sender: TObject);
begin
  if  PageControl1.ActivePage=TabSheet3 then
    Width:=740
  else
    Width:=480;
end;

end.