电脑和手机的红外通讯怎么做呀？(100分)

unit IRDAClients;

interface

uses
  Windows, SysUtils, Winsock;

type
  u_char  = Byte;
  u_short = Word;
  u_int   = DWORD;
  u_long  = DWORD;

  TSocket = Integer;

const
{ Imports from AF_IRDA.H }

  //: IrDA protocol number
  AF_IRDA = 26;
  PF_IRDA = AF_IRDA;

  SOL_IRLMP            = $00FF;

  IRLMP_ENUMDEVICES    = $00000010;
  IRLMP_IAS_SET        = $00000011;
  IRLMP_IAS_QUERY      = $00000012;
  IRLMP_SEND_PDU_LEN   = $00000013;
  IRLMP_EXCLUSIVE_MODE = $00000014;
  IRLMP_IRLPT_MODE     = $00000015;
  IRLMP_9WIRE_MODE     = $00000016;
  IRLMP_TINYTP_MODE    = $00000017;
  IRLMP_PARAMETERS     = $00000018;
  IRLMP_DISCOVERY_MODE = $00000019;

  IAS_ATTRIB_NO_CLASS  = $00000010;
  IAS_ATTRIB_NO_ATTRIB = $00000000;
  IAS_ATTRIB_INT       = $00000001;
  IAS_ATTRIB_OCTETSEQ  = $00000002;
  IAS_ATTRIB_STR       = $00000003;

  IAS_MAX_USER_STRING  = 256;
  IAS_MAX_OCTET_STRING = 1024;
  IAS_MAX_CLASSNAME    = 64;
  IAS_MAX_ATTRIBNAME   = 256;

type
  //:IrDA device ID. Should be treated as four characters, not as PChar.
  TIrdaDeviceID = array [0..3] of Byte;

  //:Socket-level IrDA device 'address' descriptor.
  TIrdaSockAddr = packed record
    irdaAddressFamily: u_short;
    irdaDeviceID     : TIrdaDeviceID;
    irdaServiceName  : array [0..24] of char;
  end; { TIrdaSockAddr }

  //:Information on one IrDA device.
  TIrdaDeviceInfo = packed record
    irdaDeviceID    : TIrdaDeviceID;
    irdaDeviceName  : array [0..21] of char;
    irdaDeviceHints1: byte;
    irdaDeviceHints2: byte;
    irdaCharSet     : byte;
  end; { TIrdaDeviceInfo }
  PIrdaDeviceInfo = ^TIrdaDeviceInfo;

  TIrdaAttribOctetSeq = packed record
    len     : longint;
    octetSeq: array [0..IAS_MAX_OCTET_STRING-1] of byte;
  end; { TIrdaAttribOctetSeq }

  TIrdaAttribUsrStr = packed record
    len    : longint;
    charSet: longint;
    usrStr : array [0..IAS_MAX_USER_STRING] of char;
  end; { TIrdaAttribUsrStr }

  //:IAS query
  TIrdaIASQuery = packed record
    irdaDeviceID  : TIrdaDeviceID;
    irdaClassName : array [0..IAS_MAX_CLASSNAME-1] of char;
    irdaAttribName: array [0..IAS_MAX_ATTRIBNAME-1] of char;
    irdaAttribType: longint;
    case integer of // irdaAttribute
      0: (irdaAttribInt: longint);
      1: (irdaAttribOctetSeq: TIrdaAttribOctetSeq);
      2: (irdaAttribUsrStr: TIrdaAttribUsrStr);
  end; { TIrdaIASQuery }
  PIrdaIASQuery = ^TIrdaIASQuery;

const
  IR_SERVICE_NAME	= 'OBEX';
  MAX_RETRIES     = 10;
  MAX_BUFFER      = 1024;

const
  // OBEX Operation codes
  OBEX_CONNECT		      : Char = #$80;
  OBEX_DISCONNECT	      : Char = #$81;
  OBEX_PUT			        : Char = #$02;
  OBEX_PUT_FINAL	      : Char = #$82;
  OBEX_GET              : Char = #$03;
  OBEX_GET_FINAL	      : Char = #$83;
//OBEX_RESERVED         : Char = #$84;
  OBEX_SETPATH          : Char = #$85;
//OBEX_RESERVED         : Char = #$86;
  OBEX_SESSION          : Char = #$87;
  OBEX_ABORT            : Char = #$FF;
  
  // OBEX Header codes
  OBEX_NAME				      : Char = #$01;
  OBEX_LENGTH			      : Char = #$C3;
  OBEX_DESCRIPTION	    : Char = #$05;
  OBEX_PALM_CREATOR_ID	: Char = #$CF;
  OBEX_BODY				      : Char = #$48;
  OBEX_END_OF_BODY		  : Char = #$49;
 
  // OBEX Response codes
  OBEX_CONTINUE			    : Char = #$90;
  OBEX_SUCCESS			    : Char = #$A0;
 
  OBEX_VERSION			    : Char = #$10;
  OBEX_CONNECT_FLAGS		: Char = #$00;


type
  TDEVICELIST = packed record
    numDevice : ULONG;
    Device    : array[0..MAX_RETRIES-1] of TIrdaDeviceInfo;
  end;
  PDeviceList = ^TDeviceLIst;


type
  TIrdaClient = class(TObject)
  private
    hSock  : TSocket;

    function SendCmd(Buf: PChar; Len: Integer): Boolean;

  public
    constructor Create;
    destructor Destroy; override;

    function FindDevices(var devlist: TDEVICELIST): Cardinal;

    function Open(ID: TIrdaDeviceID): Boolean;
    function Close: Boolean;
  end;

implementation

function TIrdaClient.SendCmd(buf: PChar; len: Integer): Boolean;
begin
  Result :=  False;
  if send(hSock, Buf^, Len, 0) <> SOCKET_ERROR then
    begin
    Result := recv(hSock, Buf^, Len, 0) <> SOCKET_ERROR;
    end;
end;

function BuildConnectPacket(buf: PChar; const target: PChar): Integer;
var
  size  : Integer;
  len   : Word;
begin
  size := strlen(target);

  buf[0] := OBEX_CONNECT;

  if(size > 0) then
    begin
    len := htons(Word(size + 3 + 7));
    Move(len, buf[1], 2);
    end
  else
    begin
    buf[1] := #$00;
    buf[2] := #$07;
    end;
    
  buf[3] := OBEX_VERSION;
  buf[4] := OBEX_CONNECT_FLAGS;
  buf[5] := #$10;
  buf[6] := #$00;

  if(size > 0) then
    begin
    buf[7] := #$46;
    buf[8] := #$00;
    buf[9] := #$0C;
    Move(target^, buf[10], size);
    end;

  if Size > 0 then Result := size + 3 + 7 else Result := 7;
end;

function BuildDisconnectPacket(buf: PChar): Integer;
begin
  buf[0] := OBEX_DISCONNECT;
  buf[1] := #$00;
  buf[2] := #$03;

  Result := 3;
end;

constructor TIrdaClient.Create;
var
  wsd     : WSADATA;
  wVersion: Word;
begin
  inherited Create;

  wVersion := MAKEWORD(2,2);
  if (WSAStartup(wVersion, wsd) <> 0) then
    begin
    raise Exception.Create('Unable to load the Winsock library!');
    end;


  hSock := socket(AF_IRDA, SOCK_STREAM, 0);
  if hSock = INVALID_SOCKET then
    begin
    raise Exception .CreateFmt('socket failed with error %d', [WSAGetLastError]);
    end;
end;

destructor TIrdaClient.Destroy;
begin
  if hSock <> INVALID_SOCKET then closesocket(hSock);

  WSACleanup();
  inherited Destroy;
end;

function TIrdaClient.FindDevices(var devlist: TDEVICELIST): Cardinal;
var
  dwDevListSz : Integer;
  ret         : Integer;
  I           : Integer;
begin
  Result := 0;
  dwDevListSz := Sizeof(TDeviceList);
  FillChar(devlist, dwDevListSz, 0);

  devlist.numDevice := 0;
  I := 0;
  while (devlist.numDevice = 0) and ( I < MAX_RETRIES) do
    begin
    ret := getsockopt(hSock, SOL_IRLMP, IRLMP_ENUMDEVICES, @devlist, dwDevListSz);
    if ret = SOCKET_ERROR then
      begin
      //printf('getsockopt(IRLMP_ENUMDEVICES) failed: %d', [WSAGetLastError]);
      Exit;
      end;
    Inc(I);
    Sleep(500);
    end;
  Result := devlist.numDevice;
end;

function TIrdaClient.Open(ID: TIrdaDeviceID): Boolean;
var
  Len    : Integer;
  irAddr : TIrdaSockAddr;
  Addr   : TSockAddr;
  Buf    : array[0..MAX_BUFFER-1] of Char;
begin
  Result := False;

  FillChar(irAddr, SizeOf(irAddr), 0);
  irAddr.irdaAddressFamily := AF_IRDA;
  irAddr.irdaDeviceID      := ID;
  irAddr.irdaServiceName   := IR_SERVICE_NAME;

  Move(irAddr, Addr, Sizeof(Addr));
  if connect(hSock, Addr, sizeof(TIrdaSockAddr)) <> SOCKET_ERROR then
    begin
    // OBEX CONNECT
    len := BuildConnectPacket(@buf, PChar(''));

    if SendCmd(@buf, len) and (buf[0] = #$A0) then
      begin
      Result := True;
      end;
    end;
end;

function TIrdaClient.Close: Boolean;
var
  Len : Integer;
  Buf : array[0..MAX_BUFFER-1] of Char;
begin
  Len := BuildDisconnectPacket(@buf);

  Result := SendCmd(@Buf, Len);
end;

end.