Сканер портов на TCPClient

Сегодня я хочу рассказать о так называемых сканерах портов. Если кто-то не в курсе, то эта специальная программа для определения открытых портов на удаленной машине.

Как это будет работать.
Программа пытается подключиться к какому-то порту из заданного диапазона. Если подключение произошло, то говорим пользователю что порт открыт, в противном же случае, говорим что нет, после переходим к следующему порту.

Практика.
Для начала нам необходимо бросить на форму следующие компоненты: 2 Label'а, 2 Edit'а, одну кнопку, компонент Memo для вывода информации о открытых (закрытых) портах, и наконец начинку нашей программы - компонент TCPClient, с закладки Internet. Измените свойство Caption у Label'ов следующим образом: Label1 - Начальный порт, Label2 - Конечный порт. Напротив каждого из Label'ов расположите Edit'ы... Надпись на кнопке можете сделать какую хотите... Итак, осталось написать лишь сам код программы... Весь код нашей программы будет состоять лишь из одного метода (процедуры). Кликните дважды на кнопке, перед вами появится окно с исходным кодом. Вот как она должна выглядеть:

procedure TForm1.Button1Click(Sender: TObject);
var
  i:Integer;
  ip:String;
begin
  ip:='127.0.0.1'; //По умолчанию сканируем себя
  if not InputQuery('Attention','Enter IP-address',ip) then exit; //Запрашиваем адрес компа.
  for i:=StrToInt(Edit1.Text) to StrToInt(Edit2.Text) do //Запускаем цикл
  begin
    TcpClient1.RemotePort:=IntToStr(i); //Устанавливаем порт
    TcpClient1.Open; //Пытаемся его открыть
    if TcpClient1.Connected then Memo1.Lines.Add(IntToStr(i)+' open'); //Если удалось, то сообщаем об этом
    TcpClient1.Close; //Закрываем порт.
  end;
end;

Вот и готов наш простейший сканер портов! Введите начальный порт, конечный порт, жмите кнопку, в появившемся окне набирайте IP-адрес жертвы и в бой.

Запрет запуска второй копии программы

program Project1;
 
uses
  Windows, Forms,
  Unit1 in 'Unit1.pas' {Form1},
  Unit2 in 'Unit2.pas' {Form2};
 
{$R *.res}
 
procedure BringItToFront(hWindow : HWND);
var
   fgThread : Cardinal;
   myAppThread : Cardinal;
begin
   fgThread := GetWindowThreadProcessId(GetForegroundWindow, nil);
   myAppThread := GetCurrentThreadId;
 
   AttachThreadInput(fgThread, myAppThread, True);
   ShowWindow(hWindow, SW_RESTORE);
   BringWindowToTop(hWindow); // Это будет работать гарантированно
   AttachThreadInput(fgThread, myAppThread, False);
end;
 
const
   MainFormCaption = 'Test';
var
   hMutex : THandle;
   hPrevWin : HWND;
begin
   ReportMemoryLeaksOnShutdown := True;
 
   Application.Initialize;
   Application.Title := 'MyProgram';
 
   hMutex := CreateMutex(nil, True, PChar(Application.Title));
   if (GetlastError = ERROR_ALREADY_EXISTS) or (GetlastError = ERROR_ACCESS_DENIED) then
   begin
      Application.MessageBox('Программа уже работает!', PChar(Application.Title),
         MB_ICONWARNING or MB_OK);
 
      // Ищем не Application.Title, а заголовок формы
      hPrevWin := FindWindow('TForm1', MainFormCaption);
      if hPrevWin <> 0 then BringItToFront(hPrevWin);
      Exit;
    end;
 
   Application.MainFormOnTaskbar := True;
   Application.CreateForm(TForm1, Form1);
   Application.CreateForm(TForm2, Form2);
   Application.Run;
end.

Необязательный параметр в процедуре (Вариант 3. Значение по умолчанию)

Иногда, Вы можете избежать потребности в перезагрузке методом OVERLOAD, давая значения конечных параметров по умолчанию. Вызывающая программа может тогда вызвать с или без этих конечных параметров.

procedure MyProc(a : Byte; b : Byte = 23);

Может быть вызвана 2-мя способами:

MyProc(15, 16);
MyProc(45); // По умолчанию b будет равно 23

Необязательный параметр в процедуре (Вариант 2. Использование Overload)

Директива Overload позволяет Вам иметь различные версии одинаково названной функции или процедуры с различными параметрами. Это полезно, когда есть множество путей, которыми код может захотеть использовать подпрограмму. Например, если подпрограмма - конструктор класса, Вы можете хотеть иметь одну версию Create, которая устанавливает значения по умолчанию, и другую, которая берет эти значения как параметры. 

Вы должны закодировать директиву Overload перед любыми другими директивами. 

При запросе перезагруженной (overloaded) подпрограммы, Delphi выбирает соответствующую версию, основанную сначала на номере параметров, затем на типах параметра. Если он не может принять решение, он выдаёт исключение. 

Когда количество параметров такое же, он всегда сначала пробует удовлетворить самые простые/наименьшие типы данных - например, вышеупомянутое значение 23 удовлетворил бы параметр Byte, чемInteger параметр. 

Пример использования

function Summ(A, B: integer): integer; overload;       // Версия 1 функции Summ

begin

  result:= A+B;

end;

function Summ(A,B,C: Integer): integer; overload;  // Версия 2 функции Summ

begin

 result:=A+B+C;

end;

Function ShowSumm;

begin

  ShowMessage(Summ(5,10));      // Используется версия 1 функции Summ

  ShowMessage(Summ(3,7,12));   // используется версия 2 функции Summ

end;

Если позволяет ситуация и чтобы не писать много одинакового кода, можно модернизировать версию 1 примера.

function Summ(A, B: integer): integer; overload;       // Измененная версия 1 функции Summ

begin

  result:= Summ(A,B, 0);

end;

В данном случае, мы вызываем версию с 3-мя параметрами, передавая два числа и 0, который не влияет на сумму). Но это частный случай.

Необязательный параметр в процедуре (Вариант 1. Открытые массивы)

Рассмотрим открытые массивы, которые позволяют передавать в функцию или процедуру различное количество параметров. В качестве параметров можно передать либо открытый массив элементов одинакового типа, либо массивы констант различного типа. В приведенном ниже примере объявляется функция, которой в качестве параметра должен передаваться открытый массив целых чисел. 

function AddEmUp( A: array of integer ): integer;

В открытом массиве можно передавать переменные, константы или выражения из констант. Ниже приведен пример, который демонстрирует вызов функции AddEmUp с передачей ей нескольких различных элементов. 

const

  j = 23;

var

  i, Rez: integer;

begin

   i := 8;

   Rez := AddEmUp( [i, 20, j, 43] );

end; 

Для получения информации о фактически передаваемом массиве параметров в функции или процедуре могут использоваться функции High, Low и SizeOf. Для иллюстрации их использования ниже приведен текст функции AddEmUp, которая возвращает сумму всех переданных ей элементов массива A. 

function AddEmUp( A: array of integer ): integer;

var

   i: integer;

begin

   Result := 0;

   for i := Low(A) to High(A) do

       Inc( Result, A[i] );

end; 

Object Pascal также поддерживает тип array of const, который позволяет передавать в одном массиве данные различных типов. Синтаксис объявления функций или процедур, использующих такой массив для получения параметров, следующий: 

procedure WhatHaveIGot( A: array of const ); 

Вызвать объявленную выше функцию можно, например, с помощью такого оператора:


procedure WhatHaveIGot( ['Text', 10, 5.5, @WhatHaveIGot, 3.14, true, 'c'] ); 

При передаче функции или процедуре массива констант все передаваемые параметры компилятор неявно конвертирует в тип TVarRec. Тип данных TVarRec объявлен в модуле System следующим образом: 

PVarRec = ^TVarRec;

TVarRec = record case

  Byte of vtInteger: (VInteger: Integer; VType: Byte);

        vtBoolean: (VBoolean: Boolean);

        vtChar: (VChar: Char);

        vtExtended: (VExtended: PExtended);

        vtString: (VString: PShortString);

        vtPointer: (VPointer: Pointer);

        vtPChar: (VPChar: PChar);

        vtObject: (VObject: TObject);

        vtClass: (VClass: TClass);

        vtWideChar: (VWideChar: WideChar);

        vtPWideChar: (VPWideChar: PWideChar);

        vtAnsiString: (VAnsiString: Pointer);

        vtCurrency: (VCurrency: PCurrency);

        vtVariant: (VVariant: PVariant);

        vtInterface: (VInterface: Pointer);

        vtWideString: (VWideString: Pointer);

        vtInt64: (VInt64: PInt64);

end;


Поле VType определяет тип содержащихся в данном экземпляре записи TVarRec данных и может принимать одно из ниже приведенных значений.

const

  vtInteger = 0;

  vtBoolean = 1;

  vtChar = 2;

  vtExtended = 3;

  vtString = 4;

  vtPointer = 5;

  vtPChar = 6;

  vtObject = 7;

  vtClass = 8;

  vtWideChar = 9;

  vtPWideChar = 10;

  vtAnsiString = 11;

  vtCurrency = 12;

  vtVariant = 13;

  vtInterface = 14;

  vtWideString = 15;

  vtInt64 = 16; 

Поскольку массив констант способен передавать данные разных типов, это может вызвать определенные затруднения при создании обрабатывающей полученные параметры функции или процедуры. В качестве примера работы с таким массивом рассмотрим реализацию процедуры WhatHaveIGot, которая просматривает элементы полученного массива параметров и выводит их тип. 

procedure WhatHaveIGot( A: array of const );

var

   i: integer; TypeStr: string;

begin

   for i := Low(A) to High(A) do begin

     case A[i].VType of

          vtInteger : TypeStr := 'Integer';

          vtBoolean : TypeStr := 'Boolean';

          vtChar : TypeStr := 'Char';

          vtExtended : TypeStr := 'Extended';

          vtString : TypeStr := 'String';

          vtPointer : TypeStr := 'Pointer';

          vtPChar : TypeStr := 'PChar';

          vtObject : TypeStr := 'Object';

          vtClass : TypeStr := 'Class';

          vtWideChar : TypeStr := 'WideChar';

          vtPWideChar : TypeStr := 'PWideChar';

          vtAnsiString : TypeStr := 'AnsiString';

          vtCurrency : TypeStr := 'Currency';

          vtVariant : TypeStr := 'Variant';

          vtInterface : TypeStr := 'Interface';

          vtWideString : TypeStr := 'WideString';

          vtInt64 : TypeStr := 'Int64';

    end;

   ShowMessage( Format( 'Array item %d is a %s', [i, TypeStr] ) );

  end;

end;

Найдено на http://programmersforum.ru/

Борьба с (WIDEMEMO) в DBGrid

При попытке вывести данные из БД в DBGrid, есть одна проблема. Данные в DBGrid могут отображаться как (WIDEMEMO). Что бы это подправить надо внести изменения в одну из двух процедур отрисовки.

procedure TForm1.DBGrid1DrawDataCell(Sender: TObject; const Rect: TRect;
Field: TField; State: TGridDrawState);
var
  Grid : TStringGrid;
  Texto : String;
  Rectangulo : TRect;
begin
  Rectangulo:=Rect;
  Grid := TStringGrid(Sender);
  if Field.IsBlob then begin
    Grid.Canvas.FillRect(Rect);
    Texto := Field.AsString;
    DrawText( Grid.Canvas.Handle,
                      PChar(Texto),
                      StrLen(PChar(Texto)),
                      Rectangulo,
                      DT_WORDBREAK);
    end;
end;

Или вот другой вариант

procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
  DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
 if Assigned(Column) then
  begin
   DBGrid1.Canvas.FillRect(Rect);
   DBGrid1.Canvas.TextRect(Rect, Rect.Left, Rect.Top, ' '+Column.Field.AsString);
  end;
end;

[SQLite] Отображение данных SQLite в DBGrid (Способ 1)

После Delphi 7, не смог сразу отобразить данные из базы SQLite в DBGrid. Необходимы дополнительные манипуляции.
В проекте который я пишу, мне нужно просто просматривать данные из базы в виде таблицы. Сделаем это. Есть несколько способов.

Способ 1. Используем провайдер

На форме у нас есть уже

• DBServer(TSQLConnection),
• SQLQuery1(TSQLQuery).

Они связаны и настроены (см. Подключаемся к базе данных (Delphi XE3 + SQLite3)).

Кроме этого необходимо задать запрос на отображение всех данных. У свойства SQL компонента SQLQuery1 прописываем следующую строку

SELECT * FROM myBid;

<myBid> - имя таблицы в базе.
Устанавливаем свойство Active в True.

Кидаем на форму DBGrid. Как я уже писал, просто так не получится его прикрутить. Необходимо использовать провайдер. Для этого нам потребуется несколько компонентов:

• DataSetProvider1(TDataSetProvider),
• ClientDataSet1(TClientDataSet),
• DateSource(TDateSource).

У DataSetProvider устанавливаем DataSet = SQLQuery1
У ClientDataSet1 устанавливаем ProviderName = DataSetProvider1, Active=True
У DataSource устанавливаем DataSet = ClientDataSet1
И наконец у DBGrid устанавливаем DataSource = DataSource1

Можно все сделать в дизайнере, сразу увидите результат. Единственное, что при изменении данных в базе, чтоб они изменились в таблице DBGrid (в режиме дизайнера) надо выключить и включить ClientDataSet1.

Связать можно и кодом, например в отдельной процедуре.

procedure LinkDBGridToBase;
begin
  SQLQuery1.SQL.Clear;
  SQLQuery1.SQL.Text :='SELECT * FROM '+TableOfBase;
  SQLQuery1.Open;

  DataSetProvider1.DataSet := SQLQuery1;
  ClientDataSet1.ProviderName := 'DataSetProvider1';
  ClientDataSet1.Active := true;
  DataSource1.DataSet := ClientDataSet1;
  DBGrid1.DataSource := DataSource1;
end;

Обратите внимание, ClientDataSet1.ProviderName является строковым параметром.

P.S. Если в полях отображается (WIDEMEMO), есть пару решений. См. Борьба с (WIDEMEMO) в DBGrid

[SQLite] Подключаемся к базе данных SQLite3 (Delphi XE3 + SQLite3)

Для реализации задач, нам необходима база данных. Желательно бесплатная и простая. И выбрал я SQLite.

Плюсы:

1. Бесплатный и открытый исходный код
2. Не нуждается в дополнительной настройке на клиентской машине, надо только одну DLL
3. Очень быстрый
4. Возможность работать в режиме только чтение и гостевого аккаунта
5. Не записывает ни чего в реестр, и другие файлы
6. Поддерживается стандартного SQL ( http://www.sqlite.org/lang.html )

Как я упомянул выше, для разработки и работы программы с базой данных нам нужна одна единственная sqlite3.dll. Она должна находиться в папке с программой, а так же в директории XE3 (RAD Studio\10.0\bin). Я еще добавил ее в Windows\system32.

Из компонентов Delphi нам понадобятся:
ActionList1(TActionList)
DBServer (TSQLConnection)
SQLQuery1(TSQLQuery)

Настройку компонентов можно сделать из дизайнера, а можно вручную.

Создадим процедуру инициализации соединения с БД через DBServer.

procedure InitialConnection(ASQLConnection: TSQLConnection; AFileName: string);
begin
  ASQLConnection.ConnectionName := 'SQLITECONNECTION';
  ASQLConnection.DriverName:='Sqlite';
  ASQLConnection.LoginPrompt:= false;
  ASQLConnection.Params.Values['Host']:='localhost';
  ASQLConnection.Params.Values['FailIfMissing']:='False';
  ASQLConnection.Params.Values['ColumnMetaDataSupported']:='False';
  ASQLConnection.Params.Values['Database']:=AFileName;
  ASQLConnection.Open;
end;

ASQLConnection.Open открывает базу, если файла нет, то создает. Если же в указанную папку нельзя записать, возникнет ошибка. Так как это не прямая функция, то обрабатывать ошибки будет вызывающая процедура (acDBServerExecute).

Для передачи SQL запросов используем SQLQuery1. Но перед использованием свяжем его с нашим соединением DBServer.

SQLQuery1.SQLConnection := DBServer;

Все, можно отправлять запросы. Так например нам надо создать таблицу в базе, если ее нет (первый раз открываем базу). Давно в исходниках INIFiles подсмотрел такой вид процедур, которые начинаются на MayBeХххх(). Как я понимаю, это процедуры которые может быть что-то делают. Так вот я использую такую процедуру для создания таблицы в безе. если ее нет.

procedure MayBeCreateTables(AQuery: TSQLQuery);
begin
  AQuery.SQL.Clear;
  AQuery.SQL.Text :='CREATE TABLE if not exists MyBids ( '+
                    'id INTEGER NOT NULL PRIMARY KEY,'+
                    'WellNo CHAR(10),'+
                    'Field CHAR(20),'+
                    'WellZaboy CHAR(10),'+
                    'WellDiam CHAR(10),'+
                    'WellRastvor CHAR(20),'+
                    'DateDone DATE,'+
                    'TimeDone TIME,'+
                    'DateConfirm DATE,'+
                    'TimeConfirm TIME,'+
                    'Task TEXT,'+
                    'Zakazhik TEXT,'+
                    'Predstavitel TEXT,'+
                    'Partia TEXT,'+
                    'Comment TEXT,'+
                    'DateRecieve DATE,'+
                    'TimeRecieve TIME,'+
                    'Status TEXT,'+
                    'DateChange DATE,'+
                    'TimeChange TIME'+
                    ');';
  AQuery.ExecSQL;
end;

Ключевым словом здесь является  if not exists в SQL запросе. Таким образом SQLite сам проверяет есть ли такая таблица и если нет, то создает. Спасибо ему за это.

Осталось собрать все в кучу и обработать возможные ошибки.

В ActionList добавим новое действие в категорию DB и назовем его acDBServerStart. В нем мы будем запускать наш сервер БД.

procedure TForm1.acDBServerStartExecute(Sender: TObject);
begin
  try
   InitialConnection(DBServer, 'C:\DB\bids.db');
   SQLQuery1.SQLConnection := DBServer;
   MayBeCreateTables(SQLQuery1);
 except
    on E: Exception do
    begin
      ShowMessage( StringReplace(E.Message, #13, ' ', [rfReplaceAll]);
      //raise;
    end;
  end;
end;

//raise - закоментировал, что бы не отображались ошибки. Их будем записывать в лог.

Таким образом мы настроили соединение, соединились и на случай отсутствия таблицы создали ее. Можно добавлять данные в таблицу.