⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 ipchgfrm.pas

📁 为了工作安全,大部分单位的计算机都进行了多部门多网段的方式进行划分处理,而有些人员需要在多网段间自由切换,为次本人编制该程序,方便公司人员的多网段转换的需要.
💻 PAS
字号:
unit IpChgFrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IPEdit, IniFiles, shellapi, WinSkinData, Menus,
  IdBaseComponent, IdComponent, IdIPWatch, ComCtrls, ExtCtrls, jpeg,
  Buttons,Registry, CoolTrayIcon;

type
  TForm1 = class(TForm)
    BtSaveIp: TSpeedButton;
    IPEdit1: TIPEdit;
    IPEdit2: TIPEdit;
    IPEdit3: TIPEdit;
    IPEdit4: TIPEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    GroupBox1: TPanel;
    BtChgIP: TSpeedButton;
    IPEdit5: TIPEdit;
    Label5: TLabel;
    MainMenu1: TMainMenu;
    F1: TMenuItem;
    Q1: TMenuItem;
    H1: TMenuItem;
    A1: TMenuItem;
    StatusBar1: TStatusBar;
    IdIPWatch1: TIdIPWatch;
    Edit1: TEdit;
    Label13: TLabel;
    IP1: TMenuItem;
    RadioGroup1: TRadioGroup;
    Panel1: TPanel;
    Memo1: TMemo;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    Bevel1: TBevel;
    BtExit: TSpeedButton;
    WRun1: TMenuItem;
    CoolTrayIcon1: TCoolTrayIcon;
    PopupMenu1: TPopupMenu;
    S1: TMenuItem;
    N1: TMenuItem;
    x1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure BtSaveIpClick(Sender: TObject);
    procedure BtChgIPClick(Sender: TObject);
    procedure Q1Click(Sender: TObject);
    procedure A1Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure IP1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure RadioGroup1Click(Sender: TObject);
    procedure BtExitClick(Sender: TObject);
    procedure IPEdit1Change(Sender: TObject);
    procedure WRun1Click(Sender: TObject);
    procedure x1Click(Sender: TObject);
    procedure S1Click(Sender: TObject);
    procedure CoolTrayIcon1Startup(Sender: TObject;
      var ShowMainForm: Boolean);
  private
    procedure SaveIpSetToRunFile();
    procedure ShowIpAddrNameGroup();
    procedure SaveIpNameList();
    procedure LoadIpNameList();
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  myinifile:TInifile;
  dir:string;
implementation

  uses ExecAndWait;

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
Var
  IpStr,nmStr:string;
  I:integer;
  Reg: TRegistry;
begin
  Panel1.Top:=50;
  Panel1.left:=50;
  IpStr:=IdIPWatch1.LocalIP;
  dir:=extractfiledir(application.ExeName);
  myinifile:=tinifile.Create(dir+'\'+'config.ini');

  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    if Reg.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Run', True) then
    begin
      WRun1.Checked:=Reg.ValueExists('GxzNetIpChg');
      Reg.CloseKey;
    end;
  finally
    Reg.Free;
  end;

  LoadIpNameList();
  ShowIpAddrNameGroup();
  for i:=0 to RadioGroup1.Items.Count-1 do
  begin
    nmStr:='IpAddr'+inttostr(i);
    if IpStr=myinifile.readstring(nmStr,'IP地址','0') then
    begin
      RadioGroup1.ItemIndex:=i;
      break;
    end;
  end;
  RadioGroup1Click(Sender);

end;

procedure TForm1.SaveIpSetToRunFile();
Var
  F : Textfile; //申明变量
begin
  //----下面代码生成 netIpcfg.txt 配置文件
  AssignFile(F,'netIpcfg.txt');
  ReWrite(F); {生成配置文件 netIpcfg.txt}
  Writeln(F,'');
  Writeln(F,'');
  Writeln(F,'# ---------------------------------- ');
  Writeln(F,'# 接口 IP 配置');
  Writeln(F,'# ---------------------------------- ');
  Writeln(F,'pushd interface ip');
  Writeln(F,'');
  Writeln(F,'');
  Writeln(F,'# "本地连接" 的接口 IP  配置');
  Writeln(F,'');
  Writeln(F,'set address name="'+Edit1.Text+'" source=static addr='+IPedit1.IPstring+' mask='+IPedit2.IPstring+'');
  Writeln(F,'set address name="本地连接" gateway='+IPedit3.IPstring+' gwmetric=1');
  Writeln(F,'set dns name="本地连接" source=static addr='+IPedit4.IPstring+' register=PRIMARY');
  Writeln(F,'add dns name="本地连接" addr='+IPedit5.IPstring+' index=2');
  Writeln(F,'set wins name="本地连接" source=static addr=none');
  Writeln(F,'');
  Writeln(F,'');
  Writeln(F,'popd');
  Writeln(F,'# 接口 IP 配置结束');
  Closefile(F); //释放变量F
  //----文件生成完毕
end;

procedure DelayMsecs(msecs:integer);
var
  FirstTickCount,NowTickCount:longint;
begin
  FirstTickCount:=GetTickCount;
  repeat
    Application.ProcessMessages;
    NowTickCount:=GetTickCount;
  until (abs(NowTickCount-FirstTickCount) >= Longint(msecs));
end;

procedure TForm1.BtChgIPClick(Sender: TObject);
begin
  BtChgIP.Enabled:=False;
  BtExit.Enabled:=False;

  SaveIpSetToRunFile();
  statusbar1.Panels[0].Text:=' 正在进行IP地址修改,请稍等...';
  Application.ProcessMessages;

  RunExeAndWait('netsh -f netIpcfg.txt');
  statusbar1.Panels[0].Text:=' IP地址已修改成: ' +IdIPWatch1.LocalIP;
  ShowMessage('IP地址修改完成');

  BtChgIP.Enabled:=True;
  BtExit.Enabled:=True;
end;

procedure TForm1.Q1Click(Sender: TObject);
begin
  Close;
end;

procedure TForm1.A1Click(Sender: TObject);
begin
  application.MessageBox('  IP地址转换工具 Ver 2.10  '#13#13'  高兴钊'#13#13'  2006.8.25','关于',64);
end;

procedure TForm1.ShowIpAddrNameGroup();
begin
  case RadioGroup1.Items.Count of
    2,3: begin
        RadioGroup1.Top:=24;
        RadioGroup1.Height:=96;
        BtSaveIp.Top:=132;
        BtChgIP.Top:=BtSaveIp.Top+36;
        BtExit.Top:=BtChgIP.Top+36;
      end;
    4,5: begin
        RadioGroup1.Top:=12;
        RadioGroup1.Height:=128;
        BtSaveIp.Top:=146;
        BtChgIP.Top:=BtSaveIp.Top+32;
        BtExit.Top:=BtChgIP.Top+32;
      end;
    else begin
        RadioGroup1.Top:=8;
        RadioGroup1.Height:=140;
        BtSaveIp.Top:=152;
        BtChgIP.Top:=BtSaveIp.Top+30;
        BtExit.Top:=BtChgIP.Top+30;
      end;
  end;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
var
  strlist:TStringList;
  i:integer;
begin
  strlist:=TStringList.Create;
  try
    for i:=0 to Memo1.Lines.Count-1 do
      if length(trim(Memo1.Lines[i]))>0 then
      begin
        if strlist.Count<10 then
          strlist.Add(trim(Memo1.Lines[i]))
        else
        begin
          application.MessageBox('地址名列表太多了(>10),想忙晕我呀?!不理你了!!! ','讨厌的家伙',16);
          break;
        end;
      end;
    if strlist.Count>1 then
    begin
      RadioGroup1.Items.Assign(strlist);
      ShowIpAddrNameGroup();
      SaveIpNameList();
      Panel1.Visible:=False;
    end
    else
      application.MessageBox('如果1个IP地址就没必要使用IP地址转换了^_^ ','傻了吧',16);
  finally
    strlist.Free;
  end;
end;

procedure TForm1.IP1Click(Sender: TObject);
begin
  Memo1.Lines.Assign(RadioGroup1.Items);
  Panel1.Visible:=True;
  Memo1.SetFocus;
end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
  Panel1.Visible:=False;
end;

procedure TForm1.RadioGroup1Click(Sender: TObject);
Var
  nmStr:string;
begin
  statusbar1.Panels[0].Text:=' 当前IP地址: '+IdIPWatch1.LocalIP;
  Edit1.Text:=myinifile.readstring('网卡配置','网卡名','0');
  nmStr:='IpAddr'+inttostr(RadioGroup1.ItemIndex);
  IPedit1.IPstring:=myinifile.readstring(nmStr,'IP地址','0');
  IPedit2.IPstring:=myinifile.readstring(nmStr,'子网掩码','0');
  IPedit3.IPstring:=myinifile.readstring(nmStr,'默认网关','0');
  IPedit4.IPstring:=myinifile.readstring(nmStr,'首选DNS','0');
  IPedit5.IPstring:=myinifile.readstring(nmStr,'备用DNS','0');
  BtSaveIp.Enabled:=False;
end;

procedure TForm1.BtSaveIpClick(Sender: TObject);
Var
  nmStr:string;
begin
  nmStr:='IpAddr'+inttostr(RadioGroup1.ItemIndex);
  myinifile.writestring('网卡配置','网卡名',Edit1.Text);
  myinifile.writestring(nmStr,'IP地址',IPedit1.IPstring);
  myinifile.writestring(nmStr,'子网掩码',IPedit2.IPstring);
  myinifile.writestring(nmStr,'默认网关',IPedit3.IPstring);
  myinifile.writestring(nmStr,'首选DNS',IPedit4.IPstring);
  myinifile.writestring(nmStr,'备用DNS',IPedit5.IPstring);
  ShowMessage(RadioGroup1.Items[RadioGroup1.ItemIndex] + ' IP地址已保存');
end;

procedure TForm1.LoadIpNameList();
Var
  i,ii:integer;
begin
  ii:=StrToInt(myinifile.readstring('IpNameList','IpNum','0'));
  if ii>0 then
  begin
    RadioGroup1.Items.Clear;
    for i:=0 to ii-1 do
      RadioGroup1.Items.Add(myinifile.readstring('IpNameList','IpName'+inttostr(i),'IpName'+inttostr(i)));
  end;
  RadioGroup1.ItemIndex:=0; 
end;

procedure TForm1.SaveIpNameList();
Var
  i:integer;
begin
  myinifile.writestring('IpNameList','IpNum',inttostr(RadioGroup1.Items.Count));
  for i:=0 to RadioGroup1.Items.Count-1 do
    myinifile.writestring('IpNameList','IpName'+inttostr(i),RadioGroup1.Items[i]);
end;

procedure TForm1.BtExitClick(Sender: TObject);
begin
  Close;
end;

procedure TForm1.IPEdit1Change(Sender: TObject);
begin
  if not BtSaveIp.Enabled then
    BtSaveIp.Enabled:=True;
end;

procedure TForm1.WRun1Click(Sender: TObject);
var
  Reg: TRegistry;
begin
  WRun1.Checked:=not WRun1.Checked;
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    if Reg.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Run', True) then
    begin
      if WRun1.Checked then
        Reg.WriteString('GxzNetIpChg','"' + ParamStr(0) + '" -h')
      else
        Reg.DeleteValue('GxzNetIpChg');
      Reg.CloseKey;
    end;
  finally
    Reg.Free;
  end;
end;

procedure TForm1.x1Click(Sender: TObject);
begin
  close;
end;

procedure TForm1.S1Click(Sender: TObject);
begin
{  if Application.MainForm.Visible then
    CoolTrayIcon1.HideMainForm
  else CoolTrayIcon1.ShowMainForm;}
  CoolTrayIcon1.ShowMainForm;
end;

procedure TForm1.CoolTrayIcon1Startup(Sender: TObject;
  var ShowMainForm: Boolean);
begin
  CoolTrayIcon1.IconVisible := True;
  if not ((ParamCount>0) and (LowerCase(ParamStr(1)) = '-h')) then
  begin
    ShowMainForm:=True;
  end;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -