обновление в блоге - Создание многопользовательского чата

[Beermonza]

NewIP := ServerSocket.Socket.Connections[i - 1].RemoteAddress

Так вы можете взять IP-адрес уже зарегистрированного пользователя, последнего, ...не факт, что оно будет точным.
Брать IP нужно сразу на входе в OnClientConnect:

NewIP := Socket.RemoteAddress

Процедура уже возвращает сокет вызвавший соединение, достаточно взять с него адрес.

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

[Shouldercannon]

Так давайте по порядку. Есть файл IPRanges.cfg. Его содержимое
127.0.0.0-127.0.0.255
128.0.0.0-128.0.0.255
129.0.0.0-129.0.0.255
Далее эти данные нужно поместить в StringList, а потом передать в массив?

[Beermonza]

Проще записать их так:

3
127.0.0.0
127.0.0.255
128.0.0.0
128.0.0.255
129.0.0.0
129.0.0.255

... при чтении командой ReadLn, в первой строке глубина цикла, от 1 до этого значения. Затем, в цикле подряд два оператора чтения ReadLn , первый сохраняет в запись ячейки "От", второй в запись "По". Сам массив от 1 до значения, что считано с первой строки файла.

[Shouldercannon]

Массив такой будет

IPRanges: array[0..255] of string;

?
Определяю сколько нужно произвести сохранений в записи ячеек "От" - "По"

...
  IPRanges: TStringList;
  Range, s: Integer;
...
procedure TForm1.FormCreate(Sender: TObject);
begin
Data := TStringList.Create;
  Data.Duplicates := dupIgnore;
end;

procedure TForm1.BLoadClick(Sender: TObject);
begin
Data.LoadFromFile('IPRanges.cfg');
  Memo1.Text := Data.Text;

Range := StrToInt(Copy(Data.Text, 1, 1));
  s := 0;
    while  s < Range do
      begin
        s := s + 1;
      end;
end;

Что делать дальше?

[Beermonza]

Сначала нужен тип массива, вот такой:

Type
  TIPList = packed record
  IP1: String;    // От
  IP2: String;    // По
end;

Теперь сам массив. Пусть будет статичный, ...много шаблонов не придется хранить:

IPRanges: array[0..255] of TIPList;

На каждую ячейку массива будет приходиться по два IP-адреса фильтра (IP1 и IP2). Файл можно задать текстовый, ничего в нем сложного нет, посему и не мудрствуем:

RangeFile: TextFile;
i, Range: Byte;
...

// инициализация файла
AssignFile(RangeFile, {путь к файлу});
// открыть для чтения
Reset(RangeFile);

// считывание глубины цикла
ReadLn(RangeFile, Range);

// цикл по числу шаблонов
For i := 1 to Range do
  Begin
    ReadLn(RangeFile, IPRanges[i].IP1);
    ReadLn(RangeFile, IPRanges[i].IP2);
  end;

// закрытие файла
CloseFile(RangeFile);

Все, шаблон в массиве. Переменная Range будет всегда хранить число шаблонов, дабы при переборе не проверять весь массив до 255-й ячейки.

Теперь примените массив также эффективно, как он и заполнялся, т.е.:

For i := 1 to Range do
  Begin
    If (NewIP >= IPtoDWORD(IPRanges[i].IP1)) and (NewIP <= IPtoDWORD(IPRanges[i].IP2)) then {пропустить}
    else {закрыть канал}
  end;

Вот и вся проверка. Я пример на работоспособность не проверял (касается IPtoDWORD), логически и синтаксически все должно работать.

[Shouldercannon]

Я пример на работоспособность не проверял (касается IPtoDWORD)

Видно на нём и ступор. Что имеем:

...
  private
    { Private declarations }
  public
    { Public declarations }
  end;

type
  TIPList = packed record
  IP1: string; {От}
  IP2: string; {По}
end;

var
  Form1: TForm1;
  NewIP: string;
  IPRanges: array[0..255] of TIPList;
  RangeFile: TextFile;
  i, Range: Byte;

implementation

{$R *.dfm}

function IPtoDWORD(const s: string):DWORD;
var
L: TStringList;
b: packed array [0..3] of byte;
i: Integer;
begin
Result := 0;
  L := TStringList.Create;
    try
      L.Delimiter := '.';
        L.DelimitedText := s;
          for i := 0 to 3 do
            b[3 - i] := StrToInt(L[i]);
              Result := pdword(@b[0])^;
    finally
      L.Free
    end;
end;

procedure TForm1.BLoadClick(Sender: TObject);
begin
{Инициализация файла}
AssignFile(RangeFile, 'IPRanges.txt');
  {Открыть для чтения}
  Reset(RangeFile);
    {Считывание глубины цикла}
    ReadLn(RangeFile, Range);
      {Цикл по числу шаблонов}
      for i := 1 to Range do
        begin
          ReadLn(RangeFile, IPRanges[i].IP1);
            ReadLn(RangeFile, IPRanges[i].IP2);
        end;
          {Закрытие файла}
          CloseFile(RangeFile);
end;

procedure TForm1.BVerifyClick(Sender: TObject);
begin
for i := 1 to Range do
  begin
    if (NewIP >= IPtoDWORD(IPRanges[i].IP1))| and (NewIP <= IPtoDWORD(IPRanges[i].IP2)) then {Пропустить} //На этой строке, где стоит |, возникает ошибка Incompatible types: 'String' and 'Cardinal'
      ShowMessage('Пропустить')
        else {Закрыть канал}
          ShowMessage('Закрыть канал');
  end;
end;

procedure TForm1.Panel1Click(Sender: TObject);
begin
NewIP := Edit1.Text;
end;

[Beermonza]

Ну тут просто несовместимость типов. IP-адрес берется строкового типа, и чтобы совместить типы, так же прогоняется через рукописную функцию:

if (IPtoDWORD(NewIP) >= IPtoDWORD(IPRanges[i].IP1)) and (IPtoDWORD(NewIP) <= IPtoDWORD(IPRanges[i].IP2)) then {Пропустить}

Должно работать.

[Shouldercannon]

Теперь работает. А так и должно быть при таком раскладе
3
127.0.0.0
127.0.0.255
128.0.0.0
128.0.0.255
129.0.0.0
129.0.0.255
Сверяю с 129.0.0.1 и дальше происходит: закрыть канал, закрыть канал, пропустить? Если да, то получается что сначала канал закрываем два раза, а потом разрешаем вход или я не так понял. И можно ли обновлять данный массив диапазонов (перезагружать)?

[Beermonza]

В вашей системе главным критерием отбора будет - "нужно ли закрыть канал". Если в файле не найдется шаблона по которому нужно пропустить подключившегося клиента, значит его нужно закрыть. Заведите счетчик, обнулите его перед перебором, проверяйте на попадание в шаблон, если попадание обнаружилось, счетчик считает. В конце, после цикла, заведите проверку счетчика, ...если он равен нулю, закрывайте канал, иначе, впускайте пользователя.

Сообщение от Shouldercannon

И можно ли обновлять данный массив диапазонов (перезагружать)?

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

[Shouldercannon]

var
...
t: Integer;
...
procedure TForm1.BVerifyClick(Sender: TObject);
begin
t := 0;
  for i := 1 to Range do
    begin
      if (IPtoDWORD(NewIP) >= IPtoDWORD(IPRanges[i].IP1)) and (IPtoDWORD(NewIP) <= IPtoDWORD(IPRanges[i].IP2)) then {Пропустить}
        t := t + 1
          else {Закрыть канал}
    end;
      if t = 0 then
        ShowMessage('Неразрешённый диапазон');
end;

Теперь то, что нужно, пока ошибок не выдавало