Обратился некий Вася, говорит мол: у меня сервак, нужно, чтобы в сети его незя было найти, когда телефон выключен, ну мол можно, чтобы, когда телефон включен сервак работал и наоборот.Тупо согласитесь?))))))
Код: Выделить всё
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, WinSock, ExtCtrls, shellapi, sGauge;
type
ip_option_information = packed record // header of an IP packet
// Otherwise, the route option should be formatted as specified in RFC 791
Ttl: byte; // Time to live
Tos: byte; // Type of service, generally 0
Flags: byte; // IP header flags, generally 0
OptionsSize: byte; // Size in bytes of options data, generally 0, max 40
OptionsData: Pointer; // Pointer to options data
end;
icmp_echo_reply = packed record
Address: u_long; // Replying address, in the form of an IPAddr structure
Status: u_long; // Status of the echo request,
//in the form of an IP_STATUS code
RTTime: u_long; // Round trip time, in milliseconds
DataSize: u_short; // Reply data size, in bytes
Reserved: u_short; // Reserved for system use
Data: Pointer; // Pointer to the reply data
Options: ip_option_information; // Reply options, in the form of an
// IP_OPTION_INFORMATION structure
end;
PIPINFO = ^ip_option_information;
PVOID = Pointer;
function IcmpCreateFile(): THandle; stdcall;
external 'ICMP.DLL' name 'IcmpCreateFile';
function IcmpCloseHandle(IcmpHandle: THandle): BOOL; stdcall;
external 'ICMP.DLL' name 'IcmpCloseHandle';
function IcmpSendEcho(IcmpHandle: THandle; // handle, returned IcmpCreateFile()
DestAddress: u_long; // Destination IP Address
RequestData: PVOID; // The buffer that contains the data to send in the request
RequestSize: Word; // The size, in bytes, of the request data buffer.
RequestOptns: PIPINFO; // A pointer to the IP header options for the request,
//in the form of an IP_OPTION_INFORMATION structure.
//May be NULL
ReplyBuffer: PVOID; // A buffer to hold any replies to the request.
ReplySize: DWORD; // The allocated size, in bytes, of the reply buffer.
// The buffer should be large enough to hold at least one
// ICMP_ECHO_REPLY structure plus RequestSize bytes of data.
Timeout: DWORD // The time, in milliseconds, to wait for replies.
): DWORD; stdcall; external 'ICMP.DLL' name 'IcmpSendEcho';
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Timer1: TTimer;
Label1: TLabel;
Label2: TLabel;
Memo1: TMemo;
Edit1: TEdit;
Label3: TLabel;
CheckBox1: TCheckBox;
Timer2: TTimer;
Edit2: TEdit;
Label4: TLabel;
sGauge1: TsGauge;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Timer2Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
namenet: string;
implementation
{$R *.dfm}
function ping_iphost(iphost: PAnsiChar): Boolean;
var
hIP: THandle;
pingBuffer: array [0 .. 31] of AnsiChar;
pIpe: ^icmp_echo_reply;
error: DWORD;
begin
Result := True;
pingBuffer := 'Data Buffer';
// Create handle
hIP := IcmpCreateFile();
//allocates a memory block
GetMem(pIpe, sizeof(icmp_echo_reply) + sizeof(pingBuffer));
try
// sends an ICMP Echo request and returns any replies
IcmpSendEcho(hIP, inet_addr(iphost), @pingBuffer,
sizeof(pingBuffer), Nil, pIpe, sizeof(icmp_echo_reply) +
sizeof(pingBuffer), 1000);
// Returns the last error reported by an operating system API call
error := GetLastError();
if (error <> 0) then
begin
Result := False;
end;
finally
//closes a handle opened by a call to IcmpCreateFile
IcmpCloseHandle(hIP);
// terminates use of the WS2_32.DLL
WSACleanup();
// frees a memory block previously allocated with GetMem
FreeMem(pIpe);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Timer1.Enabled:= TRUE;
Memo1.Lines.Clear;
Button1.Enabled:=FALSE;
Button2.Enabled:=TRUE;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Timer1.Enabled:=FALSE;
Timer2.Enabled:=FALSE;
Button1.Enabled:=TRUE;
Button2.Enabled:=FALSE;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
namenet := 'interface set interface "'+Edit2.text+'" disable';
if ping_iphost(PChar(edit1.Text))
then
begin
label2.Caption:='В сети';
sGauge1.Progress:=0;
memo1.Lines.Add('Жертва найдена: '+FormatDateTime('hh:nn:ss',now));
end
else
begin
label2.Caption:='Оффлайн';
memo1.Lines.Add('Жертва потеряна (режим самолеквидации) '+FormatDateTime('hh:nn:ss',now));
sGauge1.Progress:=sGauge1.Progress+1;
if sGauge1.Progress = 4 then
if CheckBox1.Checked = TRUE
then
begin
Timer2.Enabled:=TRUE;
Timer1.Enabled:=FALSE;
ShellExecute(handle, nil,'netsh.exe',PChar(namenet),'', SW_HIDE);
memo1.Lines.Add('Запус восстановления 99сек '+FormatDateTime('hh:nn:ss',now));
end;
end;
end;
procedure TForm1.Timer2Timer(Sender: TObject);
begin
namenet := 'interface set interface "'+Edit2.text+'" enable';
ShellExecute(handle, nil,'netsh.exe',PChar(namenet),'', SW_HIDE);
memo1.Lines.Add('Жертва найдена (восстановление): '+FormatDateTime('hh:nn:ss',now));
sGauge1.Progress:=0;
Timer1.Enabled:=TRUE;
timer2.Enabled:=FALSE;
end;
end.