Ответ на вопрос № 83673

Здравствуйте!
Мне потребовалось организовать работу с сетью (чтение и передача данных) с использованием RAW-сокетов. Вызвано это было тем, что при работе требовалось задавать в IP-заголовке тип протокола FF. Как обрабатывать это стандартными indy-компонентами я не смог найти.
Воспользовался двумя примерами, на основе которых сделал модули на прием и передачу и запустил две программы на разных ПК в локальной сети.
Но при работе в произвольный момент времени возникает ошибка, которая "крашит" одну из программ. При этом вторая программа также прекращает свою работу. Я не могу понять как такое возможно - между ними ведь находится несколько устройств, через которые проходит сигнал!
К тому же оказалось, что модуль отвечающий за прием использует процедуры, объявленные в модуле Winsock из поставки среду разработки из библиотеки wsock32.dll. А модуль передачи - те же функции, но объявленные в "самописном" модуле и импортированные из WS2_32.DLL
Попытка заставить их работать через одну и ту же DLL приводит к тому, что либо не идет прием данных через WS2_32.DLL , либо при инициализации передачи в функции SetSockOpt из wsock32.dllпоявляется ошибка "Требуемый адрес для своего контекста неверен".

Отсюда вопросы:
1. Что может вызывать такой синхронный крах двух программ на разных ПК?
2. Можно ли принимать и передавать мой нестандартный протокол какими-либо готовыми компонентами?
3. Почему одни и те же по синтаксису функции из разных DLL работают по разному?

Ну и коды из модулей ниже.

Передача

unit uTxThread;

interface

uses
Windows, Classes, SysUtils, uWinSock, Messages, uCRC32, uGlobal;

type
TTxThread = class(TThread)
public
function InitSocket: Boolean;
procedure DeInitSocket(const ExitCode: Integer);
procedure Fill_IP_HDR(iLocalHost, iRemoteHost: String);
private
Local: String;
Remote: String;
FFrameNum: int64; // номер фрейма, записываемый внутри пакета
Addr_in: sockaddr_in;
Addr_out: sockaddr_in;
IPhdr: TIPHeader;
LogData: String;
EthFrame: array[0..IPFrameSize - 1] of Byte;
MediaFrame: TMediaFrame;
hSocket: TSocket;
function GetData: Boolean;
function SendData: Boolean;
procedure ShowLog;
protected
procedure Execute; override;
end;
implementation

uses
rmMain;

{ TTxThread }

procedure TTxThread.DeInitSocket(const ExitCode: Integer);
begin
// Если была ошибка - выводим ее
if ExitCode <> 0 then
begin
LogData := 'Ошибка: ' + SysErrorMessage(WSAGetLastError);
Synchronize(ShowLog);
end;
// Закрываем сокет
if hSocket <> INVALID_SOCKET then closesocket(hSocket);
// Деинициализируем WinSock
WSACleanup;
end;

procedure TTxThread.Execute;
var
i: Byte;
begin
inherited;
if InitSocket then begin
isReadyToRcv:=true;
Fill_IP_HDR(LocalHost, RemoteHost);
// все, мы готовы работать
while not Terminated do begin
if isReadyToRcv then begin
if GetData then begin
SendData;
end;
isReadyToRcv:=false;
end;
end;
end;
// В конце освобождаем занятые ресурсы
DeInitSocket(NO_ERROR);
end;

procedure TTxThread.Fill_IP_HDR(iLocalHost, iRemoteHost: String);
var
dwFromIP : LongWord;
dwToIP : LongWord;
iIPVersion : Word;
iIPSize : Word;
testCRC: Cardinal;
begin
// преобразуем ip адреса
dwFromIP := inet_Addr(PChar(iLocalHost));
dwToIP := inet_Addr(PChar(iRemoteHost));

iIPVersion := 4;
iIPSize := sizeof(ipHdr) div sizeof(LongWord);

FillChar(ipHdr, SizeOf(TIPHeader), 0);
ipHdr.ip_verlen := (iIPVersion shl 4) or iIPSize;
ipHdr.ip_tos := 0; // IP type of service
ipHdr.ip_totallength := htons(IPFrameSize); // Total packet len
ipHdr.ip_id := 1; // Unique identifier: set to 0
ipHdr.ip_offset := 0; // Fragment offset field
ipHdr.ip_ttl := 128; // время жизни пакета
ipHdr.ip_protocol := $FF; // Protocol test type
ipHdr.ip_checksum := 0 ; // IP checksum
ipHdr.ip_srcaddr := dwFromIP; // Source address
ipHdr.ip_destaddr := dwToIP; // Destination address

FillChar(Addr_out, SizeOf(sockaddr_in), 0);
Addr_out.sin_family := AF_INET;
Addr_out.sin_port := htons(50000);
Addr_out.sin_addr.s_addr := dwToIP;

// записываем IP заголовок в массив
FillChar(EthFrame, IPFrameSize, $CC);
Move(ipHdr, EthFrame[0], SizeOf(ipHdr));
end;

function TTxThread.GetData: Boolean;
var
FramePoint: PMediaFrame;
begin
Result:=false;

// Аудио
if TxAFrames.Count>0 then begin
FramePoint:=TxAFrames.Extract(TxAFrames.First);
MediaFrame:=FramePoint^;
Dispose(FramePoint);
Result:=true;
Exit;
end;

// Видео
if TxVFrames.Count>0 then begin
FramePoint:=TxVFrames.Extract(TxVFrames.First);
MediaFrame:=FramePoint^;
Dispose(FramePoint);
Result:=true;
Exit;
end;
end;

function TTxThread.InitSocket: Boolean;
var
WSA: TWSAData;
bOpt: Integer;
begin
// инициализируем WinSock
Result := WSAStartup(WSA_VER, WSA) = NOERROR;
if not Result then
begin
LogData := 'Ошибка: ' + SysErrorMessage(WSAGetLastError);
Synchronize(ShowLog);
Exit;
end;

// создаем сокет
hSocket := Socket(AF_INET, SOCK_RAW, IPPROTO_UDP);

if hSocket = INVALID_SOCKET then
begin
LogData := 'Ошибка: ' + SysErrorMessage(WSAGetLastError);
Synchronize(ShowLog);
DeInitSocket(WSAGetLastError);
Exit;
end;

// добавляем опции работы сокета
// bOpt = 1 - IP-заголовок формирует передающая программа
// bOpt = 0 - IP-заголовок формирует операционная система
bOpt:=1;
if (SetSockOpt(hSocket, IPPROTO_IP, IP_HDRINCL, @bOpt, SizeOf(bOpt)) <> 0) then
begin
LogData := 'Ошибка: ' + SysErrorMessage(WSAGetLastError);
Synchronize(ShowLog);
DeInitSocket(WSAGetLastError);
Exit;
end;

FFrameNum:=0;

Result := True;
end;

function TTxThread.SendData: Boolean;
begin
inc(FFRameNum);
MediaFrame.Num:=FFrameNum;
// считаем CRC кадра
MediaFrame.CRC:=CRC32FULL(MediaFrame, FrameFullSize - 4);
// заносим фрейм в массив
try
Move(MediaFrame, EthFrame[SizeOf(ipHdr)], FrameFullSize);
//Отсылаем пакет с данными
if (SendTo(hSocket, ethFrame, IPFrameSize, 0, Addr_out, SizeOf(sockaddr_in)) <> IPFrameSize) then begin
Result:=false;
end
else begin
Result:=true;
end;
except
end;
end;

procedure TTxThread.ShowLog;
begin
fmMain.Memo1.Lines.Add(LogData);
SendMessage(fmMain.Memo1.Handle, WM_VSCROLL, SB_BOTTOM, 0);
end;

end.

Прием

unit uRxThread;

interface

uses
Classes, Windows, SysUtils, Messages, WinSock, uGlobal;

const
MAX_PACKET_SIZE = $10000; // 2^16
SIO_RCVALL = $98000001;
WSA_VER = $202;
MAX_ADAPTER_NAME_LENGTH = 256;
MAX_ADAPTER_DESCRIPTION_LENGTH = 128;
MAX_ADAPTER_ADDRESS_LENGTH = 8;
IPHelper = 'iphlpapi.dll';
type
USHORT = WORD;
ULONG = DWORD;
time_t = Longint;

// ip заголовок
TIPHeader = packed record
iph_verlen: UCHAR; // версия и длина заголовка
iph_tos: UCHAR; // тип сервиса
iph_length: USHORT; // длина всего пакета
iph_id: USHORT; // Идентификация
iph_offset: USHORT; // флаги и смещения
iph_ttl: UCHAR; // время жизни пакета
iph_protocol: UCHAR; // протокол
iph_xsum: USHORT; // контрольная сумма
iph_src: ULONG; // IP-адрес отправителя
iph_dest: ULONG; // IP-адрес назначения
end;
PIPHeader = ^TIPHeader;

// Структуры для выполнения GetAdaptersInfo
IP_ADDRESS_STRING = record
S: array [0..15] of Char;
end;
IP_MASK_STRING = IP_ADDRESS_STRING;
PIP_MASK_STRING = ^IP_MASK_STRING;

PIP_ADDR_STRING = ^IP_ADDR_STRING;
IP_ADDR_STRING = record
Next: PIP_ADDR_STRING;
IpAddress: IP_ADDRESS_STRING;
IpMask: IP_MASK_STRING;
Context: DWORD;
end;

PIP_ADAPTER_INFO = ^IP_ADAPTER_INFO;
IP_ADAPTER_INFO = record
Next: PIP_ADAPTER_INFO;
ComboIndex: DWORD;
AdapterName: array [0..MAX_ADAPTER_NAME_LENGTH + 3] of Char;
Description: array [0..MAX_ADAPTER_DESCRIPTION_LENGTH + 3] of Char;
AddressLength: UINT;
Address: array [0..MAX_ADAPTER_ADDRESS_LENGTH - 1] of BYTE;
Index: DWORD;
Type_: UINT;
DhcpEnabled: UINT;
CurrentIpAddress: PIP_ADDR_STRING;
IpAddressList: IP_ADDR_STRING;
GatewayList: IP_ADDR_STRING;
DhcpServer: IP_ADDR_STRING;
HaveWins: BOOL;
PrimaryWinsServer: IP_ADDR_STRING;
SecondaryWinsServer: IP_ADDR_STRING;
LeaseObtained: time_t;
LeaseExpires: time_t;
end;

TRxThread = class(TThread)
private
WSA: TWSAData;
hSocket: TSocket;
Addr_in: sockaddr_in;
Packet: array[0..MAX_PACKET_SIZE - 1] of Byte;
PacketSize: Integer;
LogData: String;
procedure ReceiveAudio;
procedure ReceiveVideo;
protected
MediaFrame: TMediaFrame;
function InitSocket: Boolean; virtual;
procedure DeInitSocket(const ExitCode: Integer); virtual;
procedure Execute; override;
public
Host: String;
OnAir: Boolean;
end;

Const
// Размеры используемых структур
IPHeaderSize = SizeOf(TIPHeader);

implementation

uses rmMain, uCRC32;

{ TRxThread }

procedure TRxThread.DeInitSocket(const ExitCode: Integer);
begin
// Если была ошибка - выводим ее
if ExitCode <> 0 then
begin
LogData := 'Ошибка Rx: ' + SysErrorMessage(ExitCode);
Synchronize(ShowPacket);
end;
// Закрываем сокет
if hSocket <> INVALID_SOCKET then closesocket(hSocket);
// Деинициализируем WinSock
WSACleanup;
end;

procedure TRxThread.Execute;
var
IPHeader: TIPHeader;
IPDataLen: Word;
bL: Word;
CRC, CuCRC, hCRC: Cardinal;
begin
// Производим инициализацию
if InitSocket then begin
try
// Крутим поток до упора
while not Terminated do begin
// Ждем получения пакета (блокирующий режим)
try
PacketSize := recv(hSocket, Packet, MAX_PACKET_SIZE, 0);
except
PacketSize:=0;
end;
OnAir:=True;

// Если есть данные - производим их разбор
if PacketSize > SizeOf(TIPHeader) then begin
// Читаем из буфера IP заголовок
Move(Packet[0], IPHeader, IPHeaderSize);
// контроль типа используемого протокола - $FF
if IPHeader.iph_protocol = $FF then begin
// контроль размера пакета - 60-14 или 671-14 ????
Case PacketSize of
46: begin
// здесь устанавливаем признак сигнала на передачу данных!!!111
isReadyToRcv:=true;
bL:=(Packet[44] shl 8) OR Packet[45];
ModStat.ModBuferLoaded:=bl div 637;
end;
657: begin
// разбрасываем в соответствующие буфера
CopyMemory(@MediaFrame, @Packet[20], SizeOf(TMediaFrame));
// считываем CRC
CRC:=MediaFrame.CRC;
// ЭТО ПУСТЫЕ ФРЕЙМЫ
if CRC = 0 then begin
// ничего не делаем
end
// ТЕПЕРЬ ОСТАЛИСЬ ТОЛЬКО ДАННЫЕ И ОШИБКИ
else begin
// вычисляем CRC
CuCRC:=CRC32FULL(MediaFrame, SizeOf(TMediaFrame)-4);
// ОШИБКА!!!
if (CRC <> CuCRC) AND (not isRcvBroken) then begin
// ничего не делаем
end
// ХОРОШИЙ ПРИЕМ
else begin
// Разбивка по типам фреймов
Case MediaFrame.PacketType of
// аудио данные
mfsTxAData: ReceiveAudio; // Передача аудиокадра
mfsRxAData: ReceiveAudio; // Передача аудиокадра
// видео данные
mfsTxVStart: ReceiveVideo; // Начало передачи данных, заголовочный кадр
mfsTxVData: ReceiveVideo; // Передача кадра
mfsTxVClose: ReceiveVideo; // Завершение передачи данных
end;
// Разбивка по типам фреймов
end;
end;
end;
end;
end;
end;
end;
finally
// В конце освобождаем занятые ресурсы
DeInitSocket(NO_ERROR);
end;
end;
end;

function TRxThread.InitSocket: Boolean;
var
PromiscuousMode: Integer;
begin
// инициализируем WinSock
Result := WSAStartup(WSA_VER, WSA) = NOERROR;
if not Result then
begin
LogData := 'Ошибка Rx: ' + SysErrorMessage(WSAGetLastError);
Synchronize(ShowPacket);
Exit;
end;
// создаем сокет
hSocket := socket(AF_INET, SOCK_RAW, IPPROTO_IP);
if hSocket = INVALID_SOCKET then
begin
DeInitSocket(WSAGetLastError);
Exit;
end;

FillChar(Addr_in, SizeOf(sockaddr_in), 0);
Addr_in.sin_family:= AF_INET;
// указываем за каким интерфейсом будем следить
Addr_in.sin_addr.s_addr := inet_addr(PChar(Host));
// связываем сокет с локальным адресом
if bind(hSocket, Addr_in, SizeOf(sockaddr_in)) <> 0 then
begin
DeInitSocket(WSAGetLastError);
Exit;
end;
OnAir:=True;
Result := True;
end;

procedure TRxThread.ReceiveAudio;
var
FramePoint: PMediaFrame;
begin
if (RxAFrames.Count<10) then begin
New(FramePoint);
FramePoint^:=MediaFrame;
try
RxAFrames.Add(FramePoint);
except
Dispose(FramePoint);
FramePoint:=nil;
end;
end;
end;

procedure TRxThread.ReceiveVideo;
var
FramePoint: PMediaFrame;
begin
if (RxVFrames.Count<1000) then begin
New(FramePoint);
FramePoint^:=MediaFrame;
try
RxVFrames.Add(FramePoint);
except
Dispose(FramePoint);
FramePoint:=nil;
end;
end;
end;

procedure TRxThread.ShowPacket;
begin
fmMain.Memo1.Lines.Add(LogData);
end;

end.

И обращение к DLL

unit uWinSock;

interface

uses
Windows;

Const
WinSocket = 'WS2_32.DLL';
IPHelper = 'iphlpapi.dll';

WSA_VER = $202;

Max_Message = 4068;

MAX_ADAPTER_NAME_LENGTH = 256;
MAX_ADAPTER_DESCRIPTION_LENGTH = 128;
MAX_ADAPTER_ADDRESS_LENGTH = 8;

WSADESCRIPTION_LEN = 256;
WSASYS_STATUS_LEN = 128;

AF_INET = 2; // internetwork: UDP, TCP, etc.
IP_HDRINCL = 2; // включаем заголовок IP пакета
SOCK_RAW = 3; // интерфейс raw-протокола

IPPROTO_IP = 0; // dummy for IP
IPPROTO_TCP = 6; // tcp
IPPROTO_UDP = 17; // user datagram protocol
IPPROTO_RAW = 255; // raw IP пакет

SOCKET_ERROR = -1;

Type
// Заголовок IP пакета
TIPHeader = record
ip_verlen : Byte;
ip_tos : Byte;
ip_totallength : Word;
ip_id : Word;
ip_offset : Word;
ip_ttl : Byte;
ip_protocol : Byte;
ip_checksum : Word;
ip_srcaddr : LongWord;
ip_destaddr : LongWord;
end;

u_char = Char;
USHORT = WORD;
u_int = Integer;
ULONG = DWORD;
time_t = Longint;

SunB = packed record
s_b1, s_b2, s_b3, s_b4: u_char;
end;

SunW = packed record
s_w1, s_w2: USHORT;
end;

in_addr = record
case integer of
0: (S_un_b: SunB);
1: (S_un_w: SunW);
2: (S_addr: ULONG);
end;
TInAddr = in_addr;

Sockaddr_in = record
case Integer of
0: (sin_family: USHORT;
sin_port: USHORT;
sin_addr: TInAddr;
sin_zero: array[0..7] of Char);
1: (sa_family: USHORT;
sa_data: array[0..13] of Char)
end;

TSockAddr = Sockaddr_in;
TSocket = u_int;

PWSAData = ^TWSAData;
WSAData = record // !!! also WSDATA
wVersion: Word;
wHighVersion: Word;
szDescription: array[0..WSADESCRIPTION_LEN] of Char;
szSystemStatus: array[0..WSASYS_STATUS_LEN] of Char;
iMaxSockets: Word;
iMaxUdpDg: Word;
lpVendorInfo: PChar;
end;
TWSAData = WSAData;

// Структуры для выполнения GetAdaptersInfo
IP_ADDRESS_STRING = record
S: array [0..15] of Char;
end;
IP_MASK_STRING = IP_ADDRESS_STRING;
PIP_MASK_STRING = ^IP_MASK_STRING;

PIP_ADDR_STRING = ^IP_ADDR_STRING;
IP_ADDR_STRING = record
Next: PIP_ADDR_STRING;
IpAddress: IP_ADDRESS_STRING;
IpMask: IP_MASK_STRING;
Context: DWORD;
end;

PIP_ADAPTER_INFO = ^IP_ADAPTER_INFO;
IP_ADAPTER_INFO = record
Next: PIP_ADAPTER_INFO;
ComboIndex: DWORD;
AdapterName: array [0..MAX_ADAPTER_NAME_LENGTH + 3] of Char;
Description: array [0..MAX_ADAPTER_DESCRIPTION_LENGTH + 3] of Char;
AddressLength: UINT;
Address: array [0..MAX_ADAPTER_ADDRESS_LENGTH - 1] of BYTE;
Index: DWORD;
Type_: UINT;
DhcpEnabled: UINT;
CurrentIpAddress: PIP_ADDR_STRING;
IpAddressList: IP_ADDR_STRING;
GatewayList: IP_ADDR_STRING;
DhcpServer: IP_ADDR_STRING;
HaveWins: BOOL;
PrimaryWinsServer: IP_ADDR_STRING;
SecondaryWinsServer: IP_ADDR_STRING;
LeaseObtained: time_t;
LeaseExpires: time_t;
end;

const
INVALID_SOCKET = TSocket(not(0));

// Определяем необходимые функции winsock 2
function closesocket(s: TSocket): Integer; stdcall;
function socket(af, Struct, protocol: Integer): TSocket; stdcall;
function sendto(s: TSocket; var Buf; len, flags: Integer; var addrto: TSockAddr; tolen: Integer): Integer; stdcall;{}
function setsockopt(s: TSocket; level, optname: Integer; optval: PChar; optlen: Integer): Integer; stdcall;
function inet_addr(cp: PChar): ULONG; stdcall;
function htons(hostshort: USHORT): USHORT; stdcall;
function WSAGetLastError: Integer; stdcall;
function WSAStartup(wVersionRequired: word; var WSData: TWSAData): Integer; stdcall;
function WSACleanup: Integer; stdcall;

// При помощи данной функции мы определим наличие сетевых интерфейсов на локальном компьютере и информацию о них
function GetAdaptersInfo(pAdapterInfo: PIP_ADAPTER_INFO; var pOutBufLen: ULONG): DWORD; stdcall; external IPHelper;

implementation

// Импортируем функции Winsock 2
function closesocket; external winsocket name 'closesocket';
function socket; external winsocket name 'socket';
function sendto; external winsocket name 'sendto';
function setsockopt; external winsocket name 'setsockopt';
function inet_addr; external winsocket name 'inet_addr';
function htons; external winsocket name 'htons';
function WSAGetLastError; external winsocket name 'WSAGetLastError';
function WSAStartup; external winsocket name 'WSAStartup';
function WSACleanup; external winsocket name 'WSACleanup';

end.

	"Knowledge itself is power" F.Bacon
Поиск \| Карта сайта \| Помощь \| О проекте \| ТТХ