Архив для месяца: Сентябрь, 2014

Я как-то уже не раз писал о том, что мы не используем стандартные компоненты доступа к БД. Почти всё самописное. И работаем мы с Oracle.

Недавно я, наконец-таки, сделал “фишку”, без которой вполне можно жить, но с ней приятнее.

Представьте, что у вас есть запрос к БД, который выполняется длительное время. Ну, например, пользователь указал слишком мягкие критерии для фильтрации данных. Или индекса в БД нет. Или запрос изначально “кривой”. Или всё вместе взятое… Для прерывания выполнения текущего обращения к серверу в OCI есть стандартная функция – OCIBreak.

У нас я реализовывал так: в отдельном потоке запускается запрос к серверу. Если запрос выполняется длительное время, то появляется модальное окошко с кнопкой [Прервать]:

По завершению запроса – окошко скрывается. Если пользователь успеет нажать кнопку – вызывается OCIBreak,  и запрос корректно прерывается.

Таймаут до появления такого окошка установлен в две секунды – большинство запросов отрабатывают гораздо быстрее. Но если вдруг пользователь видит это окно, то на интуитивном уровне он может догадаться, что надо как-то ограничивать параметры своего запроса.

Однако иногда бывает так, что OCIBreak не прерывает запрос. Точнее он его прерывает, но приходится долго ждать. Это встречается у нас всё реже, но встречается, обычно в старых запросах, когда клиент говорит серверу – мол сделай то-то, а я подожду. И пока сервер не закончит транзакцию – приложение как бы “висит”. А если пользователь испугался и нажал [Перервать] – начинается откат транзакции. И пользователь снова ждёт, пока сервер не отпустит транзакцию. А приложение – продолжает “висеть”.  И, по хорошему, дождаться бы. Но это раздражает, и есть “продвинутые” пользователи, которые тупо прекращают выполнение программы через диспетчер задач.

Вот для таких, довольно редких случаев, я реализовал дополнительную “фишку” – принудительное прерывание. Работает так: если в течении 5 секунд OCIBreak не отпустил обращение к БД, то кнопка [Перервать] превращается в [Принудительно] и её снова можно нажать.

Что же происходит в этом случае? (Сначала я пробовал убить поток, выполняющий обращение к серверу, но это, конечно же, ничем хорошим не кончилось.)

При нажатии на кнопку [Принудительно] я делаю две вещи:

• запускаю отдельным потоком вторую сессию к БД и выполняю: alter system kill session »:sid, :serial» immediate;
• разрываю текущее TCP-соединение на стороне приложения.

Первый пункт нужен, чтобы сервер понял о наших намерениях – мы не собираемся больше ждать. Второй пункт для меня был не тривиальным. Не вдаваясь в подробности поиска решения, привожу код модуля, который у меня получился:

unit MyMIBUtils;

interface

uses
  Windows;

type
  ULONG = Integer;
  PVOID = Pointer;

const
  ANY_SIZE = 1;
  AF_INET = 2;

type
  PMIB_TCPROW = ^MIB_TCPROW;
  _MIB_TCPROW_W2K = packed record
    dwState: DWORD;
    dwLocalAddr: DWORD;
    dwLocalPort: DWORD;
    dwRemoteAddr: DWORD;
    dwRemotePort: DWORD;
  end;
  MIB_TCPROW = _MIB_TCPROW_W2K;
  TMibTcpRow = MIB_TCPROW;
  PMibTcpRow = PMIB_TCPROW;

const
  MIB_TCP_STATE_CLOSED = 1;
  MIB_TCP_STATE_LISTEN = 2;
  MIB_TCP_STATE_SYN_SENT = 3;
  MIB_TCP_STATE_SYN_RCVD = 4;
  MIB_TCP_STATE_ESTAB = 5;
  MIB_TCP_STATE_FIN_WAIT1 = 6;
  MIB_TCP_STATE_FIN_WAIT2 = 7;
  MIB_TCP_STATE_CLOSE_WAIT = 8;
  MIB_TCP_STATE_CLOSING = 9;
  MIB_TCP_STATE_LAST_ACK = 10;
  MIB_TCP_STATE_TIME_WAIT = 11;
  MIB_TCP_STATE_DELETE_TCB = 12;

type
  TCP_TABLE_CLASS = Integer;

const
  TCP_TABLE_BASIC_LISTENER = 0;
  TCP_TABLE_BASIC_CONNECTIONS = 1;
  TCP_TABLE_BASIC_ALL = 2;
  TCP_TABLE_OWNER_PID_LISTENER = 3;
  TCP_TABLE_OWNER_PID_CONNECTIONS = 4;
  TCP_TABLE_OWNER_PID_ALL = 5;
  TCP_TABLE_OWNER_MODULE_LISTENER = 6;
  TCP_TABLE_OWNER_MODULE_CONNECTIONS = 7;
  TCP_TABLE_OWNER_MODULE_ALL = 8;

type
  PMIB_TCPROW_OWNER_PID = ^MIB_TCPROW_OWNER_PID;
  MIB_TCPROW_OWNER_PID = packed record
    dwState: DWORD;
    dwLocalAddr: DWORD;
    dwLocalPort: DWORD;
    dwRemoteAddr: DWORD;
    dwRemotePort: DWORD;
    dwOwningPid: DWORD;
  end;
  TMibTcpRowOwnerPid = MIB_TCPROW_OWNER_PID;
  PMibTcpRowOwnerPid = PMIB_TCPROW_OWNER_PID;

  PMIB_TCPTABLE_OWNER_PID = ^MIB_TCPTABLE_OWNER_PID;
  MIB_TCPTABLE_OWNER_PID = packed record
    dwNumEntries: DWord;
    Table: array [0..ANY_SIZE - 1] of MIB_TCPROW_OWNER_PID ;
  end;
  TMibTcpTableOwnerPid = MIB_TCPTABLE_OWNER_PID;
  PMibTcpTableOwnerPid = PMIB_TCPTABLE_OWNER_PID;


function SetTcpEntry(const pTcpRow: MIB_TCPROW): DWORD; stdcall;
function GetExtendedTcpTable(pTcpTable: PVOID; var dwSize: DWORD; bOrder: BOOL;
  ulAf: ULONG; TableClass: TCP_TABLE_CLASS; Reserved: ULONG): DWORD; stdcall;

function KillProcessAllTCPConnections(AProcessId: DWORD): DWORD;

implementation

const
  iphlpapilib = 'iphlpapi.dll';

function SetTcpEntry; external iphlpapilib name 'SetTcpEntry';
function GetExtendedTcpTable; external iphlpapilib name 'GetExtendedTcpTable';

function KillProcessAllTCPConnections(AProcessId: DWORD): DWORD;
var
  TCPTable: PMibTcpTableOwnerPid;
  Size: DWORD;
  Res: DWORD;
  I: DWORD;
  TCPRow: TMibTcpRow;
begin
  Result := 0;
  TcpTable := nil;
  Size := 0;
  Res := GetExtendedTcpTable(TCPTable, Size, False, AF_INET, TCP_TABLE_OWNER_PID_CONNECTIONS, 0);
  if Res <> ERROR_INSUFFICIENT_BUFFER then
    Exit;
  GetMem(TCPTable, Size);
  try
    Res := GetExtendedTcpTable(TCPTable, Size, False, AF_INET, TCP_TABLE_OWNER_PID_CONNECTIONS, 0);
    if Res <> NO_ERROR then
      Exit;

    for I := 0 to TCPTable^.dwNumEntries - 1 do
      if TCPTable^.Table[I].dwOwningPID = AProcessId then
        with TCPTable^.Table[I] do
        begin
          TCPRow.dwState := MIB_TCP_STATE_DELETE_TCB;
          TCPRow.dwLocalAddr := dwLocalAddr;
          TCPRow.dwLocalPort := dwLocalPort;
          TCPRow.dwRemoteAddr := dwRemoteAddr;
          TCPRow.dwRemotePort := dwRemotePort;
          Res := SetTCPEntry(TCPRow);
          if Res = NO_ERROR then
            Inc(Result);
        end;
  finally
    FreeMem(TCPTable);
  end;
end;

end.

Этот код работает на Windows XP with SP2 и выше.

Соответственно я вызываю:

  KillProcessAllTCPConnections(GetCurrentProcessId);

и все текущие TCP-соединения моего процесса прерываются (а у меня оно всего одно). Получить информацию о TCP-соединении, которое используется именно текущим OCI-обращением к серверу мне не удалось, да я особо и не пытался. Если вдруг понадобится – это можно сделать, просмотрев активные соединения непосредственно до и после коннекта к БД.

P.S.: Пару слов про NonBlocking-mode, который есть в OCI. В современном мире многопоточных операционных систем его не рекомендуется использовать вовсе.

Читать на сайте автора.

Читать на сайте автора.

В предыдущей заметке я упомянул о хелпере для отладки сообщений Windows. Эта заметка будет предельно краткой: ссылки на исходники и скриншот демки.

Исходник: модуль MsgHlpr.pas. Использовать можно так:

procedure TfrmMain.ApplicationEvents1Message(var Msg: TMsg; var Handled: Boolean);
begin
  Memo1.Lines.Add(Msg.ToString);
..

Демо-приложение:

Скачать: MsgHlpr.pas + демо — zip-архив, MsgHlpr.pas на GitHub, исходник демо на GitHub, исполняемый exe-файл демки (zip-архив, 447 КБ).

Работает в Delphi 2010 и выше, при желании легко адаптировать и к предыдущим версиям Delphi.

Читать на сайте автора.