program sendtest;
{$APPTYPE CONSOLE}
uses
SysUtils, windows, winsock2;
const
AF_BTH = 32;
BTHPROTO_RFCOMM = 3;
BT_MAC = 'B8:27:EB:F1:38:CC';
BT_PORT = 10;
BT_CLASS = '{00000000-0000-0000-0000-000000000000}';
type
BTH_ADDR = UInt64;
PSockAddrBth = ^TSockAddrBth;
TSockAddrBth = packed record
addressFamily : USHORT;
btAddr : BTH_ADDR;
serviceClassId : TGUID;
port : ULONG;
end;
function connectBT(const s: TSocket; name: PSockAddrBth; namelen: Longint): Longint; stdcall;external WINSOCK2_DLL name 'connect';
function str2ba(const str_bt_addr: string): BTH_ADDR;
var
addr : array[1..6] of Integer;
i, first, last : Integer;
bt_addr : BTH_ADDR;
begin
Result := 0;
bt_addr := 0;
first := 1;
for i := 1 to 5 do begin
last := Pos(':', str_bt_addr, first);
if last = 0 then Exit;
if not TryStrToInt('$'+Copy(str_bt_addr, first, last-first), addr[i]) then Exit;
if addr[i] > 255 then Exit;
first := last+1;
end;
if not TryStrToInt('$'+Copy(str_bt_addr, first, MaxInt), addr[6]) then Exit;
if addr[6] > 255 then Exit;
for i := 1 to 6 do bt_addr := (bt_addr shl 8) or BTH_ADDR(Byte(addr[i]));
Result := bt_addr;
end;
var
WSinfo : WSADATA;
Rslt, i, ErrNo : Integer;
s : TSocket;
clientservice : TSockAddrBth;
clientservptr : PSockAddrBth;
SendBuf : Array[0..5] of Byte;
BytesSent : Integer;
RecvBuf : Array[0..1023] of Byte;
BytesRecv : Integer;
BEGIN
for i := 0 to 5 do SendBuf[i] := 0;
for i := 0 to 1023 do RecvBuf[i] := 0;
ErrNo := 0;
while true do begin
Rslt := WSAStartup(MAKEWORD(2,2), WSinfo);
if Rslt <> NO_ERROR then begin
ErrNo := WSAGetLastError;
writeln('Error at WSAStartup');
break;
end;
s := socket(AF_BTH, SOCK_STREAM, BTHPROTO_RFCOMM);
if s = INVALID_SOCKET then begin
ErrNo := WSAGetLastError;
writeln('Error at Socket');
break;
end;
clientservice.addressFamily := AF_BTH;
clientservice.btAddr := str2ba(BT_MAC);
clientservice.serviceClassId := StringtoGUID(BT_CLASS);
clientservice.port := BT_PORT;
clientservptr := @clientservice;
if connectBT(s, clientservptr, SizeOf(clientservice)) = SOCKET_ERROR then begin
ErrNo := WSAGetLastError;
writeln('Error at Connect');
break;
end;
BytesSent := send(s, SendBuf, 6, 0);
writeln('Bytes sent: ', BytesSent);
if BytesSent <> 6 then begin
ErrNo := WSAGetLastError;
writeln('Error at Send');
break;
end;
BytesRecv := recv(s, RecvBuf, 1024, 0);
writeln('Bytes received A: ', BytesRecv);
if s <> INVALID_SOCKET then begin
Rslt := shutdown(s, SD_SEND);
if Rslt <> 0 then begin
ErrNo := WSAGetLastError;
writeln('Error at Shutdown Send');
break;
end;
repeat
BytesRecv := recv(s, RecvBuf, 1024, 0);
writeln('Bytes received B: ', BytesRecv);
until BytesRecv = 0;
Rslt := shutdown(s, SD_RECEIVE);
if Rslt <> 0 then begin
ErrNo := WSAGetLastError;
writeln('Error at Shutdown Receive');
break;
end;
Rslt := closesocket(s);
if Rslt <> 0 then begin
ErrNo := WSAGetLastError;
writeln('Error at Close Socket');
break;
end;
end;
break;
end;
if ErrNo <> 0 then
writeln(SysErrorMessage(ErrNo)+' [Error code '+Inttostr(ErrNo)+']')
else
writeln('Success!');
WSACleanUp;
END.
Recent
