unmain.~pas
来自「用DELPHI写的网卡启动禁用程序」· ~PAS 代码 · 共 678 行 · 第 1/2 页
~PAS
678 行
Rg:=TRegistry.Create;
try
rg.RootKey:=HKEY_LOCAL_MACHINE;
if Rg.OpenKey('\SYSTEM\ControlSet001\Control\Network\{4D36E972-E325-11CE-BFC1-08002BE10318}\'+Adapter.AdapterName+'\Connection',false) then
Result:=Rg.ReadString('Name');
finally
rg.Free;
end;
end;
procedure TfmNetWorkChange.ReadIniDataToTreeView(AdapterName:string);
var
RF:TIniFile;
FName:String;
FNameList:TStrings;
i:integer;
FNode:TTreeNode;
begin
FIpTree.Items.Clear;
fName:=ExtractFilePath(Application.ExeName)+'net.ini';
if not FileExists(FName) then exit;
rf:=TIniFile.Create(FName);
FNameList:=TStringList.Create;
RF.ReadSections(FNameList);
try
for i:=0 to FNameList.Count-1 do
begin
if RF.ReadString(FNameList.Strings[i],'Name','')=AdapterName then begin
FNode:=FIpTree.items.Add(nil,FNameList.Strings[i]);
if RF.ReadString(FNameList.Strings[i],'Name','')<>'' then
FIpTree.items.AddChild(fnode,RF.ReadString(FNameList.Strings[i],'Name',''));
if RF.ReadString(FNameList.Strings[i],'IP','')<>'' then
FIpTree.items.AddChild(fnode,RF.ReadString(FNameList.Strings[i],'IP',''));
if RF.ReadString(FNameList.Strings[i],'MASK','')<>'' then
FIpTree.items.AddChild(fnode,RF.ReadString(FNameList.Strings[i],'MASK',''));
if RF.ReadString(FNameList.Strings[i],'GATEWAY','')<>'' then
FIpTree.items.AddChild(fnode,RF.ReadString(FNameList.Strings[i],'GATEWAY',''));
if RF.ReadString(FNameList.Strings[i],'DNS1','')<>'' then
FIpTree.items.AddChild(fnode,RF.ReadString(FNameList.Strings[i],'DNS1',''));
if RF.ReadString(FNameList.Strings[i],'DNS2','')<>'' then
FIpTree.items.AddChild(fnode,RF.ReadString(FNameList.Strings[i],'DNS2',''));
end;
end;
finally
FNameList.Free;
RF.Free;
end;
end;
procedure TfmNetWorkChange.BtnAppsetClick(Sender: TObject);
var
CmdStr:string;
fnode:TTreeNode;
i:integer;
begin
fnode:=FIpTree.Selected;
FmAni:=TFmAni.Create(Application);
FmAni.Canvas.Font.Size:=11;
FmAni.Canvas.Font.Color:=clred;
FmAni.Show;
FmAni.Canvas.TextOut(15,10,'程序正在应用新配置,请稍候..');
FlashWindow(FmAni.Handle,true);
// Self.Hide;
if not Assigned(fnode) then Exit;
if fnode.HasChildren then begin
FmAni.Canvas.TextOut(15,10,'程序正在应用新配置,请稍候....');
CmdStr:=format('netsh interface ip set address name=%s static %s %s %s 1',[fnode.Item[0].Text,fnode.Item[1].Text,fnode.Item[2].Text,fnode.Item[3].Text]);
// ShowMessage(CmdStr);
WinExecAndWait(cmdstr);
FmAni.Canvas.TextOut(10,10,'程序正在应用新配置,请稍候.......');
FlashWindow(FmAni.Handle,true);
if (fnode.Count=5) then begin
CmdStr:=Format('netsh interface ip set dns %s static %s',[fnode.Item[0].Text,fnode.Item[4].text]);
// ShowMessage(CmdStr);
WinExecAndWait(cmdstr);
FmAni.Canvas.TextOut(10,10,'程序正在应用新配置,请稍候..........');
FlashWindow(FmAni.Handle,true);
end;
if (fnode.Count=6) then begin
CmdStr:=Format('netsh interface ip delete dns %s all ',[fnode.Item[0].Text]);
WinExecAndWait(cmdstr);
CmdStr:=Format('netsh interface ip add dns %s %s ',[fnode.Item[0].Text,fnode.Item[4].text]);
// ShowMessage(CmdStr);
WinExecAndWait(cmdstr);
FmAni.Canvas.TextOut(10,10,'程序正在应用新配置,请稍候............');
FlashWindow(FmAni.Handle,true);
CmdStr:=Format('netsh interface ip add dns %s %s ',[fnode.Item[0].Text,fnode.Item[5].text]);
WinExecAndWait(cmdstr);
FmAni.Canvas.TextOut(10,10,'程序正在应用新配置,请稍候...............');
FlashWindow(FmAni.Handle,true);
// ShowMessage(CmdStr);
end;
end;
//
FmAni.Canvas.TextOut(10,10,'程序正在应用新配置,请稍候............完毕');
FlashWindow(FmAni.Handle,true);
sleep(1000);
// fmNetWorkChange.Show;
FmAni.Close;
btnRetryClick(Sender);
end;
procedure TfmNetWorkChange.BtnDelIniClick(Sender: TObject);
var
iFile:TIniFile;
FName:string;
begin
if AdapterList.ItemIndex<0 then exit;
FName:=ExtractFilePath(Application.ExeName)+'net.ini';
if FileExists(FName) then begin
iFile:=TIniFile.Create(FName);
iFile.EraseSection(FIpTree.Selected.Text);
iFile.UpdateFile;
iFile.Free;
ReadIniDataToTreeView(TAdapter(AdapterList.Items.Objects[AdapterList.ItemIndex]).Name);
end;
end;
{ TAdapter }
destructor TAdapter.Destroy;
var
i:integer;
begin
for i:=0 to IpMasklist.Count-1 do IpMasklist.Objects[i].Free;
for i:=0 to Dnslist.Count-1 do Dnslist.Objects[i].Free;
for i:=0 to CurrDns.Count-1 do CurrDns.Objects[i].Free;
for i:=0 to Gatewaylist.Count-1 do Gatewaylist.Objects[i].Free;
IpMasklist.Free;
Dnslist.Free;
CurrDns.Free;
Gatewaylist.Free;
inherited;
end;
procedure TfmNetWorkChange.btnActiveNetAdapterClick(Sender: TObject);
var
i:integer;
begin
if DevForm=nil then DevForm:=TDevForm.Create(Application);
DevForm.ShowModal;
sleep(1000);
btnRetryClick(Sender);
end;
procedure TfmNetWorkChange.btnRetryClick(Sender: TObject);
var
i:integer;
begin
GetApt;
for i:=0 to AdapterList.Items.Count-1 do AdapterList.Items[i].ImageIndex:=0;
Check(NIni,AdapterList);
end;
procedure TfmNetWorkChange.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
begin
//canclose:=false;
end;
procedure TfmNetWorkChange.N3Click(Sender: TObject);
begin
Application.Terminate;
end;
procedure TfmNetWorkChange.N1Click(Sender: TObject);
begin
if Visible=false then ShowModal else JvTrayIconApp.ShowApplication;
// Application.ShowMainForm:=true;
//JvTrayIconApp.ShowApplication;
end;
procedure TfmNetWorkChange.Button5Click(Sender: TObject);
begin
JvTrayIconApp.HideApplication;
end;
procedure TfmNetWorkChange.FormCreate(Sender: TObject);
begin
IniMenuItem;
// btnRetryClick(Sender)
end;
procedure TfmNetWorkChange.IniMenuItem;
var
FName,DefaultIP,DefaultGateWay:string;
FItem:TMenuItem;
FList:TStrings;
FIni:TIniFile;
i:integer;
begin
GetApt;
FName:=ExtractFilePath(Application.ExeName)+'net.ini';
if FileExists(FName) then
begin
FList:=TStringList.Create;
FIni:=TIniFile.Create(FName);
try
FIni.ReadSections(FList);
for i:=0 to FList.Count-1 do
begin
FItem:=TMenuItem.Create(nil);
FItem.Caption:=FList.Strings[i];
FItem.Checked:=true;
FItem.OnClick:=ItemClick;
NIni.Add(FItem);
end;
finally
Fini.Free;
FList.Free
end;
end;
end;
procedure TfmNetWorkChange.ItemClick(sender: TObject);
var
FName,CmdStr:string;
FIni:TIniFile;
AName,FDNS1,FDNS2,AIP,AMask,AGateway,ADesc:string;
i:integer;
FState:boolean;
begin
//
if TMenuItem(sender).Checked then exit;
FState:=true;
FName:=ExtractFilePath(Application.ExeName)+'net.ini';
if FileExists(FName) then
begin
FIni:=TIniFile.Create(FName);
try
AName:=FIni.ReadString(TMenuItem(sender).Caption,'Name','');
AIP:=FIni.ReadString(TMenuItem(sender).Caption,'IP','');
AMask:=FIni.ReadString(TMenuItem(sender).Caption,'MASK','');
AGateway:=FIni.ReadString(TMenuItem(sender).Caption,'GateWay','');
ADesc:=FIni.ReadString(TMenuItem(sender).Caption,'Desc','');
FDNS1:=FIni.ReadString(TMenuItem(sender).Caption,'Dns1','');
FDNS2:=FIni.ReadString(TMenuItem(sender).Caption,'Dns2','');
finally
Fini.Free;
end;
for i:=0 to AdapterList.Items.Count-1 do
begin
if TAdapter(AdapterList.Items.Objects[i]).Description=ADesc then begin
FState:=true;
break;
end else FState:=false;
end;
if FState=false then begin
DevForm:=TDevForm.Create(Application);
DevForm.ShowModal;
sleep(1000);
btnRetryClick(Sender);
end;
FmAni:=TFmAni.Create(Application);
FmAni.Canvas.Font.Size:=11;
FmAni.Canvas.Font.Color:=clred;
FmAni.Show;
FmAni.Canvas.TextOut(15,10,'程序正在应用新配置,请稍候..');
FlashWindow(FmAni.Handle,true);
FmAni.Canvas.TextOut(15,10,'程序正在应用新配置,请稍候....');
CmdStr:=format('netsh interface ip set address name=%s static %s %s %s 1',[AName,AIP,AMask,AGateway]);
WinExecAndWait(cmdstr);
FmAni.Canvas.TextOut(10,10,'程序正在应用新配置,请稍候........');
FlashWindow(FmAni.Handle,true);
CmdStr:=Format('netsh interface ip delete dns %s all ',[AName]);
WinExecAndWait(cmdstr);
if FDNS1<>'' then begin
CmdStr:=Format('netsh interface ip add dns %s %s',[AName,FDNS1]);
WinExecAndWait(cmdstr);
FmAni.Canvas.TextOut(10,10,'程序正在应用新配置,请稍候...........');
FlashWindow(FmAni.Handle,true);
end;
if FDNS2<>'' then begin
CmdStr:=Format('netsh interface ip add dns %s %s ',[AName,FDNS2]);
WinExecAndWait(cmdstr);
FmAni.Canvas.TextOut(10,10,'程序正在应用新配置,请稍候..............');
FlashWindow(FmAni.Handle,true);
end;
FmAni.Canvas.TextOut(10,10,'程序正在应用新配置,请稍候..............完毕');
FlashWindow(FmAni.Handle,true);
sleep(1000);
FmAni.Close;
btnRetryClick(Sender);
end;
end;
procedure TfmNetWorkChange.Check(AMenuItem: TMenuItem;
AList: TJvImageComboBox);
var
i,j:integer;
FName,DefaultGateWay,DefaultIP,ADefaultGateWay,ADefaultIP:string;
Fini:TIniFile;
begin
FName:=ExtractFilePath(Application.ExeName)+'net.ini';
if FileExists(FName) then begin
try
Fini:=TIniFile.Create(FName);
for i:=0 to AMenuItem.Count-1 do AMenuItem.Items[i].Checked:=false;
for i:=0 to AMenuItem.Count-1 do
begin
DefaultIP:=FIni.ReadString(AMenuItem.Items[i].Caption,'IP','');
DefaultGateWay:=fini.ReadString(AMenuItem.Items[i].Caption,'GateWay','');
for j:=0 to AList.Items.Count-1 do
begin
ADefaultGateWay:=TAdapter(AdapterList.Items.Objects[j]).Gatewaylist.Strings[0];
ADefaultIP:=TIP(TAdapter(AdapterList.Items.Objects[j]).IpMasklist.Objects[0]).IP;
if ADefaultIP=DefaultIP then
if ADefaultGateWay=DefaultGateWay then begin
AMenuItem.Items[i].Checked:=true;
break;
end;
end;
end;
finally
Fini.Free;
end;
end;
end;
end.
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?