Сканирование свободных ip адресов и запись в SQL

unit frmMain_code;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdRawBase, IdRawClient,
  IdIcmpClient, DB, ADODB, Winsock, IniFiles, ExtCtrls;
 
const
  MAX_ADAPTER_ADDRESS_LENGTH = 6;
 
type
  TfrmMain = class(TForm)
    memoLog: TMemo;
    btnStart: TButton;
    Icmp: TIdIcmpClient;
    btnClearLog: TButton;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    edtIP1: TEdit;
    edtIP2: TEdit;
    edtIP3: TEdit;
    Label2: TLabel;
    Label3: TLabel;
    edtTimeout: TEdit;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    adoConnection: TADOConnection;
    adotblAddress: TADOTable;
    btnStop: TButton;
    Label4: TLabel;
    edtIntervalStart: TEdit;
    edtIntervalEnd: TEdit;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    edtDaysToFree: TEdit;
    Label11: TLabel;
    Label12: TLabel;
    edtMaxLinesInLog: TEdit;
    Label13: TLabel;
    Timer1: TTimer;
    edtPingInterval: TEdit;
    Label14: TLabel;
    Label15: TLabel;
    GroupBox2: TGroupBox;
    edtServer: TEdit;
    Label16: TLabel;
    edtDataBaseName: TEdit;
    Label17: TLabel;
    Label18: TLabel;
    Label19: TLabel;
    edtLogin: TEdit;
    edtPassword: TEdit;
    chkWriteToDB: TCheckBox;
    adoqCreateBase: TADOQuery;
    btnCreateBase: TButton;
    chkAutoStart: TCheckBox;
    procedure btnStartClick(Sender: TObject);
    procedure IcmpReply(ASender: TComponent;
      const AReplyStatus: TReplyStatus);
    procedure btnClearLogClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btnStopClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Timer1Timer(Sender: TObject);
    procedure adoConnectionBeforeConnect(Sender: TObject);
    procedure adoConnectionBeforeDisconnect(Sender: TObject);
    procedure adoConnectionConnectComplete(Connection: TADOConnection;
      const Error: Error; var EventStatus: TEventStatus);
    procedure btnCreateBaseClick(Sender: TObject);
  private
    IniFile: TIniFile;
    MaxLinesInLog: integer;
    DaysToFree: Extended;
    procedure CheckBase;
  public
    BreakFlag: boolean;
  end;
 
  TthrPing = class(TThread)
  protected
    procedure PingProcess;
    procedure Execute; override;
  end;
 
  TMacAddress = array[0..MAX_ADAPTER_ADDRESS_LENGTH - 1] of byte;
 
  function SendARP(const DestIP, SrcIP: ULONG;
    pMacAddr: PULONG; var PhyAddrLen: ULONG): DWORD; stdcall; external 'IPHLPAPI.DLL';
 
var
  frmMain: TfrmMain;
  thrPing: TthrPing;
 
implementation
 
{$R *.dfm}
 
function GetMAC(Value: TMacAddress; Length: DWORD): String;
var
  I: Integer;
begin
  if Length = 0 then Result := '00-00-00-00-00-00' else
  begin
    Result := '';
    for i:= 0 to Length - 2 do
      Result := Result + IntToHex(Value[i], 2) + '-';
    Result := Result + IntToHex(Value[Length-1], 2);
  end;
end;
 
//function IPToName(IPAddr : string): string;
function IPToName(IPAddr : integer): string;
var
  SockAddrIn: TSockAddrIn;
  HostEnt: PHostEnt;
  WSAData: TWSAData;
begin
  WSAStartup($101, WSAData);
  SockAddrIn.sin_addr.s_addr:=IPAddr;
  HostEnt:= gethostbyaddr(@SockAddrIn.sin_addr.S_addr, 4, AF_INET);
  if HostEnt <> nil then
    result:=StrPas(HostEnt^.h_name)
  else
    result:='';
end;
 
procedure TfrmMain.btnStartClick(Sender: TObject);
begin
  CheckBase;
 
  Timer1.Interval:=StrToInt(edtPingInterval.Text)*3600000;
  Timer1.Enabled:=true;
 
  memoLog.Clear;
  memoLog.Lines.Add('Ïðîâåðêà íà÷àëàñü '+DateTimeToStr(Now));
  BreakFlag:=false;
  thrPing:=TthrPing.Create(false);
end;
 
procedure TfrmMain.IcmpReply(ASender: TComponent;
  const AReplyStatus: TReplyStatus);
var
  answer,hostname,macaddr: string;
  answer_id: integer;
  prev_response: TDateTime;
  CloseAfterUse: boolean;
 
  DestIP: ULONG;
  pMacAddr: TMacAddress;
  PhyAddrLen: ULONG;
begin
  if BreakFlag=true then
    Exit;
    
  case Icmp.ReplyStatus.ReplyStatusType of
    rsEcho: begin answer:='OK'; answer_id:=1; end;
    rsTimeOut: begin answer:='Error. Òàéìàóò.'; answer_id:=2; end;
    rsErrorUnreachable: begin answer:='Error. Óçåë íåäîñòóïåí.'; answer_id:=2; end;
    rsErrorTTLExceeded: begin answer:='Error. Ïðåâûøåíî âðåìÿ æèçíè ïàêåòà.'; answer_id:=4; end;
  else
    begin answer:='Error'; answer_id:=5; end;
  end;
 
  hostname:='';
  macaddr:='';
  if answer_id=1 then
  begin
    DestIP := inet_addr(PAnsiChar(Icmp.Host));
    hostname:=IPtoName(DestIP);
    PhyAddrLen := 6;
    SendArp(DestIP, 0, @pMacAddr, PhyAddrLen);
    macaddr:=GetMAC(pMacAddr, PhyAddrLen);
    memoLog.Lines.Add('Ping to '+Icmp.Host+' ('+hostname+') '+macaddr+' - '+answer);
  end
  else
    memoLog.Lines.Add('Ping to '+Icmp.Host+' - '+answer);
 
  if memoLog.Lines.Count>MaxLinesInLog then
    memoLog.Clear;
 
  if chkWriteToDB.Checked=false then
    exit;
 
  CloseAfterUse:=false;
 
  if adotblAddress.Active=false then
  begin
    adotblAddress.Open;
    CloseAfterUse:=true;
  end;
 
  if adotblAddress.Locate('IPaddress',Icmp.Host,[])=true then
    with adotblAddress do
    begin
      Edit;
      FieldValues['LastPingTime']:=Now;
      if FieldByName('LastResponseTime').IsNull=false then
        prev_response:=FieldByName('LastResponseTime').AsDateTime
      else
        prev_response:=0;
      FieldValues['LastPingStatus']:=answer_id;
      if answer_id=1 then
        begin
          FieldValues['Hostname']:=hostname;
          FieldValues['IsFree']:=0;
          FieldValues['LastResponseTime']:=Now;
          FieldValues['MACaddress']:=macaddr;
        end
      else
        if ((prev_response<>0) and (Int(Now-prev_response)>=DaysToFree)) then
          FieldValues['IsFree']:=1;
      Post;
    end
  else
      with adotblAddress do
      begin
        Append;
        FieldValues['IPaddress']:=Icmp.Host;
        FieldValues['Hostname']:=hostname;
        if answer_id>1 then
          FieldValues['IsFree']:=1
        else
          begin
            FieldValues['IsFree']:=0;
            FieldValues['LastResponseTime']:=Now;
            FieldValues['MACaddress']:=macaddr;
          end;
        FieldValues['LastPingTime']:=Now;
        FieldValues['LastPingStatus']:=answer_id;
        Post;
      end;
 
  if CloseAfterUse=true then
    adoConnection.Close;
end;
 
procedure TfrmMain.btnClearLogClick(Sender: TObject);
begin
  memoLog.Clear;
end;
 
procedure TfrmMain.FormCreate(Sender: TObject);
begin
  memoLog.Clear;
  IniFile:=TIniFile.Create(ChangeFileExt(Application.ExeName, '.ini'));
  try
    edtIP1.Text:=IniFile.ReadString('main','ip1','192');
    edtIP2.Text:=IniFile.ReadString('main','ip2','168');
    edtIP3.Text:=IniFile.ReadString('main','ip3','0');
    edtIntervalStart.Text:=IniFile.ReadString('main','interval_start','1');
    edtIntervalEnd.Text:=IniFile.ReadString('main','interval_end','254');
    edtTimeout.Text:=IntToStr(IniFile.ReadInteger('constants','timeout',1000));
    edtMaxLinesInLog.Text:=IntToStr(IniFile.ReadInteger('constants','MaxLinesInLog',510));
    edtDaysToFree.Text:=IntToStr(IniFile.ReadInteger('constants','DaysToFree',31));
    edtPingInterval.Text:=IntToStr(IniFile.ReadInteger('constants','PingInterval',3));
    edtServer.Text:=IniFile.ReadString('database','server','OVG\OVG_SQL');
    edtDataBaseName.Text:=IniFile.ReadString('database','base_name','PingToBase');
    edtLogin.Text:=IniFile.ReadString('database','login','sa');
    edtPassword.Text:=IniFile.ReadString('database','password','sa');
    chkWriteToDB.Checked:=IniFile.ReadBool('database','use_db',true);
    chkAutoStart.Checked:=IniFile.ReadBool('main','autostart',false);
  finally
    IniFile.Free;
  end;
  MaxLinesInLog:=StrToInt(edtMaxLinesInLog.Text);
  DaysToFree:=StrToInt(edtDaysToFree.Text);
  if chkAutoStart.Checked=true then
    btnStart.Click;
end;
 
procedure TfrmMain.btnStopClick(Sender: TObject);
begin
    BreakFlag:=true;
    Timer1.Enabled:=false;
    frmMain.memoLog.Lines.Add('Ïðîâåðêà îñòàíîâëåíà. '+DateTimeToStr(Now));
end;
 
{ TthrPing }
 
procedure TthrPing.Execute;
begin
  inherited;
  Synchronize(PingProcess);
end;
 
procedure TthrPing.PingProcess;
var
  i,IntervalStart,IntervalEnd: integer;
  common_part,LogFileName,dts: String;
  breaked : boolean;
  FormatSettings: TFormatSettings;
begin
  common_part:=frmMain.edtIP1.Text+'.'+frmMain.edtIP2.Text+'.'+frmMain.edtIP3.Text+'.';
  IntervalStart:=StrToInt(frmMain.edtIntervalStart.Text);
  IntervalEnd:=StrToInt(frmMain.edtIntervalEnd.Text);
 
  if frmMain.chkWriteToDB.Checked=true then
    if frmMain.adotblAddress.Active=false then
      frmMain.adotblAddress.Open;
 
  breaked:=false;
  for i:=IntervalStart to IntervalEnd do
  begin
    Application.ProcessMessages;
    frmMain.Icmp.Host:=common_part+IntToStr(i);
    frmMain.Icmp.ReceiveTimeout:=StrToInt(frmMain.edtTimeout.Text);
    frmMain.Icmp.Ping;
    if frmMain.BreakFlag=true then
    begin
      breaked:=true;
      Break;
    end;
  end;
  if breaked=false then
  begin
    frmMain.memoLog.Lines.Add('Ïðîâåðêà çàâåðøåíà '+DateTimeToStr(Now));
    GetLocaleFormatSettings(LOCALE_SYSTEM_DEFAULT,FormatSettings);
    FormatSettings.DateSeparator:='-';
    FormatSettings.TimeSeparator:='-';
    FormatSettings.ShortDateFormat:='yyyy/mm/dd';
    FormatSettings.LongTimeFormat:='hh:nn:ss';
    dts:=DateTimeToStr(Now,FormatSettings);
    while Pos(' ', dts)>0 do
      dts[Pos(' ', dts)]:='_';
    LogFileName:=ChangeFileExt(Application.ExeName,'')+'_log_'+dts+'.log';
    frmMain.memoLog.Lines.SaveToFile(LogFileName);
  end;
 
  if frmMain.adoConnection.Connected=true then
    frmMain.adoConnection.Close;
end;
 
procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  IniFile:=TIniFile.Create(ChangeFileExt(Application.ExeName, '.ini'));
  try
    IniFile.WriteString('main','ip1',edtIP1.Text);
    IniFile.WriteString('main','ip2',edtIP2.Text);
    IniFile.WriteString('main','ip3',edtIP3.Text);
    IniFile.WriteString('main','interval_start',edtIntervalStart.Text);
    IniFile.WriteString('main','interval_end',edtIntervalEnd.Text);
    IniFile.WriteBool('main','autostart',chkAutoStart.Checked);
 
    IniFile.WriteInteger('constants','timeout',StrToInt(edtTimeout.Text));
    IniFile.WriteInteger('constants','MaxLinesInLog',StrToInt(edtMaxLinesInLog.Text));
    IniFile.WriteInteger('constants','DaysToFree',StrToInt(edtDaysToFree.Text));
    IniFile.WriteInteger('constants','PingInterval',StrToInt(edtPingInterval.Text));
 
    IniFile.WriteBool('database','use_db',chkWriteToDB.Checked);
    IniFile.WriteString('database','server',edtServer.Text);
    IniFile.WriteString('database','base_name',edtDataBaseName.Text);
    IniFile.WriteString('database','login',edtLogin.Text);
    IniFile.WriteString('database','password',edtPassword.Text);
  finally
    IniFile.Free;
  end;
 
  if adotblAddress.Active=true then
    adotblAddress.Close;
  if adoConnection.Connected=true then
    adoConnection.Close;
end;
 
procedure TfrmMain.Timer1Timer(Sender: TObject);
begin
  memoLog.Lines.Add('Íîâàÿ ïðîâåðêà íà÷àëàñü '+DateTimeToStr(Now));
  BreakFlag:=false;
  thrPing:=TthrPing.Create(false);
end;
 
procedure TfrmMain.adoConnectionBeforeConnect(Sender: TObject);
begin
  adoConnection.LoginPrompt:=false;
  adoConnection.ConnectionString:='Password='
    +edtPassword.Text+';Persist Security Info=True;User ID='
    +edtLogin.Text+';Initial Catalog='
    +edtDataBaseName.Text+';OLE DB Services=-2;Data Source='+edtServer.Text;
end;
 
procedure TfrmMain.adoConnectionBeforeDisconnect(Sender: TObject);
begin
  if adotblAddress.Active=true then
    adotblAddress.Close;
end;
 
procedure TfrmMain.adoConnectionConnectComplete(Connection: TADOConnection;
  const Error: Error; var EventStatus: TEventStatus);
var
  s:string;
begin
  if EventStatus<>esOK then
    begin
      s:=WideCharToString(PWideChar(Error.Description));
      Application.MessageBox(PAnsiChar(s),'Îøèáêà ïðè ñîåäèíåíèè',MB_OK+MB_ICONERROR)
    end
  else
    adotblAddress.Open;
end;
 
procedure TfrmMain.CheckBase;
var
  adotblTempTable: TADOTable;
begin
  if chkWriteToDB.Checked=false then
    Exit;
    
  if adoConnection.Connected=false then
    adoConnection.Open;
 
  if adoConnection.Connected=false then
    Exit;
 
  adotblTempTable:=TADOTable.Create(Self);
  adotblTempTable.Connection:=adoConnection;
  adotblTempTable.TableName:='tblPingStatuses';
  adotblTempTable.ReadOnly:=false;
  adotblTempTable.Open;
 
  if adotblTempTable.Locate('id',1,[])=false then
    with adotblTempTable do
      AppendRecord([1,'OK']);
 
  if adotblTempTable.Locate('id',2,[])=false then
    with adotblTempTable do
      AppendRecord([2,'Error: Òàéìàóò']);
 
  if adotblTempTable.Locate('id',3,[])=false then
    with adotblTempTable do
      AppendRecord([3,'Error: Óçåë íåäîñòóïåí']);
 
  if adotblTempTable.Locate('id',4,[])=false then
    with adotblTempTable do
      AppendRecord([4,'Error: Ïðåâûøåíî âðåìÿ æèçíè ïàêåòà']);
 
  if adotblTempTable.Locate('id',5,[])=false then
    with adotblTempTable do
      AppendRecord([5,'Error']);
 
  adotblTempTable.Close;
  adotblTempTable.Free;
end;
 
procedure TfrmMain.btnCreateBaseClick(Sender: TObject);
var
  ScriptFileName: string;
begin
  if adoConnection.Connected=false then
    adoConnection.Open;
 
  ScriptFileName:=ChangeFileExt(Application.ExeName,'')+'_create_db.sql';
 
  adoqCreateBase.SQL.Clear;
  adoqCreateBase.SQL.LoadFromFile(ScriptFileName);
  adoqCreateBase.ExecSQL;
  adoqCreateBase.Close;
 
  adoConnection.Close;
  Application.MessageBox('Òàáëèöû ñîçäàíû','Çàâåðøåíî',MB_OK+MB_ICONINFORMATION)
end;
 
end.