Аллахушка Уакбарушка...

Исходники делфи, готовые программы/приложения и т.д.
Ответить
Аватара пользователя
glGizma
Site Admin
Сообщения: 218
Зарегистрирован: Ср сен 27, 2017 2:20 pm

Аллахушка Уакбарушка...

Сообщение glGizma » Вс окт 03, 2021 2:26 pm

Аллахушка Уакбарушка... - суть программы такая, что если к Вам на контору нагрянет ОБЭП и заглушат вифи/сеть, а к вифи/сеть подключен телефон или иное сетевое устройство, то прога глушить сетевое подключение на сервере.
Тупо согласитесь?))))))
Обратился некий Вася, говорит мол: у меня сервак, нужно, чтобы в сети его незя было найти, когда телефон выключен, ну мол можно, чтобы, когда телефон включен сервак работал и наоборот.

Код: Выделить всё

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.
Вложения
aa.png
aa.png (34.25 КБ) 12802 просмотра
telshutdown.rar
(419.41 КБ) 543 скачивания

Ответить