awwnsock.pas

测试用例

      end;
      Result := nil;
    end;
  {$IFDEF Win32}
  finally
    UnlockList;
  end;                                                               
  {$ENDIF}
end;

function TApdWinsockDispatcher.CloseCom : Integer;
  { -Close the socket (and connected client's socket) and cleanup }
var
  Connection : TWsConnection;
begin
  {$IFDEF Win32}
  ApdSocket.LockList;
  try                                                                
  {$ENDIF}
    Connection := ApdSocket.FindConnection(CidEx);
    if Assigned(Connection) then
      with Connection do begin
        Result := Shutdown;
        Free;
        LastSocket := -1;
        LastConnection := nil;
      end
    else Result := -1;
  {$IFDEF Win32}
  finally
    ApdSocket.UnLockList;
  end;                                                              
  {$ENDIF}
end;

function TApdWinsockDispatcher.EscapeComFunction(Func : Integer) : LongInt;
  { -Perform the extended comm function Func }
begin
  Result := 0;
end;

function TApdWinsockDispatcher.FlushCom(Queue : Integer) : Integer;
  { -Flush the input or output buffer }
var
  Connection : TWsConnection;
begin
  Connection := ApdSocket.FindConnection(CidEx);
  if Assigned(Connection) then begin
    case Queue of
      0 : Connection.FlushOutBuffer;
      1 : Connection.FlushInBuffer;
    end;
  end;
  Result := ecOK;
end;

function TApdWinsockDispatcher.GetComError(var Stat : TComStat) : Integer;
  { -Get the current error and update Stat }
var
  Connection : TWsConnection;
  OutBytes : Cardinal;
begin
  Connection := ApdSocket.FindConnection(CidEx);
  if Assigned(Connection) then begin
    with Connection do begin
      Stat.cbInQue := GetInChars;
      { Fudge a little to ensure enough room for IACs and satisfy the }
      { dispatcher's assumptions... }
      OutBytes := GetOutChars;
      Stat.cbOutQue := OutBytes;
    end;
  end;
  { since we're a nonblocking socket, practically every function will }
  { return WSAEWOULDBLOCK, filter it out here so it doesn't propagate }
  { through to the OnTriggerXxx events }
  if ApdSocket.LastError <> WSAEWOULDBLOCK then                          {!!.05}
    Result := ApdSocket.LastError                                        {!!.05}
  else                                                                   {!!.05}
    Result := 0;                                                         {!!.05}
end;

function TApdWinsockDispatcher.GetComEventMask(EvtMask : Integer) : Cardinal;
  { -Set the communications event mask }
begin
  Result := 0;
end;

function TApdWinsockDispatcher.GetComState(var DCB : TDCB) : Integer;
  { -Fill in DCB with the current communications state }
begin
  DCB.BaudRate := 19200;
  DCB.ByteSize := 8;
  DCB.StopBits := 1;
  DCB.Parity := 0;
  Result := 0;
end;

function TApdWinsockDispatcher.OpenCom(ComName : PChar; InQueue, OutQueue : Cardinal) : Integer;
  { -Open the socket specified by ComName }
begin
  try
    {$IFDEF Win32}
    ApdSocket.LockList;
    try
    {$ENDIF}
      Result := TWsConnection.CreateInit(ApdSocket, InQueue, OutQueue).SocketHandle;
    {$IFDEF Win32}
    finally
      ApdSocket.UnLockList;
    end;                                                              
    {$ENDIF}
    CidEx := Result;
  except
    Result := -ApdSocket.LastError;
  end;
end;

function TApdWinsockDispatcher.ReadCom(Buf : PChar; Size : Integer) : Integer;
  { -Read Size bytes from Connection }
var
  Connection : TWsConnection;
begin
  Result := 0;
  Connection := ApdSocket.FindConnection(CidEx);
  if Assigned(Connection) then
    if Connection.ConnectionState = wcsConnected then begin
      Result := Connection.ReadBuf(Buf^, Size);
    end;
end;

{$IFNDEF Win32}
function TApdWinsockDispatcher.SetComEventMask(EvtMask : Cardinal) : PWord;
  { -Not supported under Winsock }
begin
  Result := nil;
end;
{$ENDIF}

function TApdWinsockDispatcher.SetComState(var DCB : TDCB) : Integer;
  { -Set the a new communications device state from DCB }
begin
  Result := ecOk;
end;

function TApdWinsockDispatcher.WriteCom(Buf : PChar; Size : Integer) : Integer;
  { -Write data to Connection }
var
  Connection : TWsConnection;
begin
  Result := 0;
  Connection := ApdSocket.FindConnection(CidEx);
  if Assigned(Connection) then
    Result := Connection.WriteBuf(Buf^, Size);
end;

function TApdWinsockDispatcher.ProcessCommunications : Integer;
  {-Not needed, communications are always running in separate threads}
begin
  Result := Dispatcher(0, 1, 0);
end;

{$IFNDEF Win32}
procedure TApdWinsockDispatcher.SetMsrShadow(OnOff : Boolean);
  { -Set MsrShadow option }
begin
  { Do nothing -- doesn't apply to Winsock }
end;
{$ENDIF}

function TApdWinsockDispatcher.SetupCom(InSize, OutSize : Integer) : Boolean;
  { -Bind Socket, and Connect or Listen }
var
  Connection : TWsConnection;
  Dummy : Bool;                                                      

  function IsError(EC : Integer) : Boolean;
  begin
    Result := False;
    if EC = SOCKET_ERROR then
      Result := ApdSocket.LastError <> WSAEWOULDBLOCK;
  end;

begin
  Result := False;
  Dummy := True;
  if IsError(ApdSocket.SetSocketOptions(CidEx, Sol_Socket, So_ReuseAddr, Dummy, SizeOf(Dummy))) then Exit; 
  if IsError(ApdSocket.BindSocket(CidEx, WsHostAddr)) then Exit;
  if IsError(ApdSocket.SetAsyncStyles(CidEx, DefAsyncStyles)) then Exit;
  if WsIsClient then begin
    if IsError(ApdSocket.ConnectSocket(CidEx, WsSockAddr)) then Exit;
  end else
    if IsError(ApdSocket.ListenSocket(CidEx, 5)) then Exit;
  Connection := ApdSocket.FindConnection(CidEx);
  if Assigned(Connection) then
    with Connection do begin
      IsClient := WsIsClient;
      IsTelnet := WsIsTelnet;
      FDispatcher := Self;
    end;
  Result := True;
end;

function TApdWinsockDispatcher.Dispatcher(Msg : Cardinal;
                       wParam : Cardinal; lParam : LongInt) : Cardinal;
  {-Dispatch Winsock functions}

begin
  Result := 0;

  if InDispatcher then exit;

  InDispatcher := True;
  try
    {Check for events at each open port}

    if ClosePending then Exit;

    RefreshStatus;

    if ComStatus.cbInQue > 0 then
      ExtractData;

    {Check for triggers}
    if (wParam = 0) and not EventBusy then begin

      GlobalStatHit := False;                                       
      while CheckTriggers and not ClosePending do
        ;

      {Allow status triggers to hit again}
      if GlobalStatHit then
        ResetStatusHits;

    end else
    {Attempt at re-entrancy}
    if DLoggingOn then
      AddDispatchEntry(dtError, dstNone, 0, nil, 0);

  finally
    InDispatcher := False;
    if ClosePending then
      DonePortPrim;                                                   
  end;
end;

function WsCommTimer(H : TApdHwnd; Msg, wParam : Cardinal;
                      lParam : LongInt) : Cardinal;
                    {$IFDEF Win32} stdcall; export; {$ELSE} export; {$ENDIF}
  {-Dispatch COMM functions}
var
  I : Integer;
begin
  for I := 0 to pred(PortList.Count) do
    if (I < PortList.Count) and (PortList[i] <> nil) then             
      with TApdWinsockDispatcher(PortList[i]) do
        if (TimerID = wParam) then begin
          Result := Dispatcher(0, 0, lParam);
          Exit;
        end;
  Result := 0;
end;

procedure TApdWinsockDispatcher.InitSocketData(LocalAddress, Address : Longint;
                       Port : Cardinal; IsClient, IsTelnet : Boolean);
begin
  {Init Winsock data}
  WsIsClient := IsClient;
  WsIsTelnet := IsTelnet;
  WsSockAddr.sin_family := AF_INET;
  WsSockAddr.sin_port := Port;
  WsSockAddr.sin_addr := TInAddr (Address);
  WsHostAddr.sin_family := AF_INET;
  if not IsClient then
    WsHostAddr.sin_port := Port;
end;

procedure TApdWinsockDispatcher.StartDispatcher;
begin
  {See if we're already active}
  if DispActive then
    raise Exception.Create('Dispatcher already started');

  DispActive := True;

  TimerID := SetTimer(0, 1, TimerFreq, @WsCommTimer);
  if TimerID = 0 then
    raise Exception.Create('Resource not available');

  {Start dispatcher}
  CreateDispatcherWindow;
end;

procedure TApdWinsockDispatcher.StopDispatcher;
begin
  if not DispActive then
    Exit;                                                            

  KillTimer(0, TimerID);
  {Shut down dispatcher}
  DestroyWindow(DispatcherWindow);
  DispActive := False;
end;

{$IFDEF Win32}
function TApdWinsockDispatcher.WaitComEvent(var EvtMask : DWORD;
                               lpOverlapped : POverlapped) : Boolean; 
begin
  { Doesn't apply to Winsock }
  Result := True;
end;
{$ENDIF}

function DispatcherWndFunc(hWindow : TApdHwnd; Msg, wParam : Cardinal;
                           lParam : Longint) : Longint;
                           {$IFDEF Win32}
                           stdcall; export;
                           {$ELSE}
                           export;
                           {$ENDIF}
  {-Window function for wm_CommNotify or cw_ApdSocketMessage messages}
var
  I : Integer;
begin
  Result := 0;
  if Msg = cm_ApdSocketMessage then begin
    for I := 0 to pred(PortList.Count) do begin
      if (I < PortList.Count) and (PortList[i] <> nil) then
        with TApdWinsockDispatcher(PortList[i]) do
          if (CidEx = Integer(wParam)) then begin                    
            Result := Dispatcher(Msg, 0, lParam);
            break;
          end;
    end;
  end else
    Result := DefWindowProc(hWindow, Msg, wParam, lParam);
end;

procedure RegisterDispatcherClass;
const
  Registered : Boolean = False;
var
  XClass: TWndClass;
begin
  if Registered then
    Exit;
  Registered := True;

  with XClass do begin
    Style         := 0;
    lpfnWndProc   := @DispatcherWndFunc;
    cbClsExtra    := 0;
    cbWndExtra    := 0;
    {$IFDEF VERSION3}
    if ModuleIsLib and not ModuleIsPackage then
      hInstance   := SysInit.hInstance
    else
      hInstance   := System.MainInstance;
    {$ELSE}
    hInstance     := System.hInstance;
    {$ENDIF}
    hIcon         := 0;
    hCursor       := 0;
    hbrBackground := 0;
    lpszMenuName  := nil;
    lpszClassName := DispatcherClassName;
  end;
  WinProcs.RegisterClass(XClass);
end;

procedure DeactivateAwWnSock;
  { -Frees the ApdSocket object }
begin
  ApdSocket.Free;
end;

{$IFNDEF Win32}
var
  SaveExit : Pointer;

procedure AwWnSockExit; far;
begin
  ExitProc := SaveExit;
  DeactivateAwWnSock;
end;
{$ENDIF}

initialization

  {$IFNDEF Win32}
  SaveExit := ExitProc;
  ExitProc := @AwWnSockExit;
  {$ENDIF}

  {if not (csDesigning in ComponentState) then}
    RegisterDispatcherClass;
  {Create the ApdSocket}
  ApdSocket := TApdDeviceSocket.Create(nil);

{$IFDEF Win32}
finalization
  DeactivateAwWnSock;
{$ENDIF}
end.