spcomm.pas

PC机控制系统程序

  FXonLimit := Limit;

  if hCommFile <> 0 then
    _SetCommState
end;

procedure TComm.SetXoffLimit(Limit: WORD);
begin
  if Limit = FXoffLimit then
    Exit;

  FXoffLimit := Limit;

  if hCommFile <> 0 then
    _SetCommState
end;

procedure TComm.SetByteSize(Size: TByteSize);
begin
  if Size = FByteSize then
    Exit;

  FByteSize := Size;

  if hCommFile <> 0 then
    _SetCommState
end;

procedure TComm.SetParity(p: TParity);
begin
  if p = FParity then
    Exit;

  FParity := p;

  if hCommFile <> 0 then
    _SetCommState
end;

procedure TComm.SetStopBits(Bits: TStopBits);
begin
  if Bits = FStopBits then
    Exit;

  FStopBits := Bits;

  if hCommFile <> 0 then
    _SetCommState
end;

procedure TComm.SetXonChar(c: AnsiChar);
begin
  if c = FXonChar then
    Exit;

  FXonChar := c;

  if hCommFile <> 0 then
    _SetCommState
end;

procedure TComm.SetXoffChar(c: AnsiChar);
begin
  if c = FXoffChar then
    Exit;

  FXoffChar := c;

  if hCommFile <> 0 then
    _SetCommState
end;

procedure TComm.SetReplacedChar(c: AnsiChar);
begin
  if c = FReplacedChar then
    Exit;

  FReplacedChar := c;

  if hCommFile <> 0 then
    _SetCommState
end;

procedure TComm.SetReadIntervalTimeout(v: DWORD);
begin
  if v = FReadIntervalTimeout then
    Exit;

  FReadIntervalTimeout := v;

  if hCommFile <> 0 then
    _SetCommTimeout
end;

procedure TComm.SetReadTotalTimeoutMultiplier(v: DWORD);
begin
  if v = FReadTotalTimeoutMultiplier then
    Exit;

  FReadTotalTimeoutMultiplier := v;

  if hCommFile <> 0 then
    _SetCommTimeout
end;

procedure TComm.SetReadTotalTimeoutConstant(v: DWORD);
begin
  if v = FReadTotalTimeoutConstant then
    Exit;

  FReadTotalTimeoutConstant := v;

  if hCommFile <> 0 then
    _SetCommTimeout
end;

procedure TComm.SetWriteTotalTimeoutMultiplier(v: DWORD);
begin
  if v = FWriteTotalTimeoutMultiplier then
    Exit;

  FWriteTotalTimeoutMultiplier := v;

  if hCommFile <> 0 then
    _SetCommTimeout
end;

procedure TComm.SetWriteTotalTimeoutConstant(v: DWORD);
begin
  if v = FWriteTotalTimeoutConstant then
    Exit;

  FWriteTotalTimeoutConstant := v;

  if hCommFile <> 0 then
    _SetCommTimeout
end;

(******************************************************************************)
//  READ THREAD
(******************************************************************************)

//
//  PROCEDURE: TReadThread.Execute
//
//  PURPOSE: This is the starting point for the Read Thread.
//
//  PARAMETERS:
//    None.
//
//  RETURN VALUE:
//    None.
//
//  COMMENTS:
//
//    The Read Thread uses overlapped ReadFile and sends any data
//    read from the comm port to the Comm32Window.  This is
//    eventually done through a PostMessage so that the Read Thread
//    is never away from the comm port very long.  This also provides
//    natural desynchronization between the Read thread and the UI.
//
//    If the CloseEvent object is signaled, the Read Thread exits.
//
//        Separating the Read and Write threads is natural for a application
//    where there is no need for synchronization between
//    reading and writing.  However, if there is such a need (for example,
//    most file transfer algorithms synchronize the reading and writing),
//    then it would make a lot more sense to have a single thread to handle
//    both reading and writing.
//
//

procedure TReadThread.Execute;
var
  szInputBuffer: array[0..INPUTBUFFERSIZE - 1] of Char;
  nNumberOfBytesRead: DWORD;

  HandlesToWaitFor: array[0..2] of THandle;
  dwHandleSignaled: DWORD;

  fdwEvtMask   : DWORD;

   // Needed for overlapped I/O (ReadFile)
  overlappedRead: TOverlapped;

   // Needed for overlapped Comm Event handling.
  overlappedCommEvent: TOverlapped;
label
  EndReadThread;
begin
  FillChar(overlappedRead, Sizeof(overlappedRead), 0);
  FillChar(overlappedCommEvent, Sizeof(overlappedCommEvent), 0);

     // Lets put an event in the Read overlapped structure.
  overlappedRead.hEvent := CreateEvent(nil, True, True, nil);
  if overlappedRead.hEvent = 0 then
  begin
    PostHangupCall;
    goto EndReadThread
  end;

     // And an event for the CommEvent overlapped structure.
  overlappedCommEvent.hEvent := CreateEvent(nil, True, True, nil);
  if overlappedCommEvent.hEvent = 0 then
  begin
    PostHangupCall();
    goto EndReadThread
  end;

     // We will be waiting on these objects.
  HandlesToWaitFor[0] := hCloseEvent;
  HandlesToWaitFor[1] := overlappedCommEvent.hEvent;
  HandlesToWaitFor[2] := overlappedRead.hEvent;

     // Setup CommEvent handling.

     // Set the comm mask so we receive error signals.
  if not SetCommMask(hCommFile, EV_ERR or EV_RLSD or EV_RING) then
  begin
    PostHangupCall;
    goto EndReadThread
  end;

     // Start waiting for CommEvents (Errors)
  if not SetupCommEvent(@overlappedCommEvent, fdwEvtMask) then
    goto EndReadThread;

     // Start waiting for Read events.
  if not SetupReadEvent(@overlappedRead,
    szInputBuffer, INPUTBUFFERSIZE,
    nNumberOfBytesRead) then
    goto EndReadThread;

     // Keep looping until we break out.
  while True do
  begin
          // Wait until some event occurs (data to read; error; stopping).
    dwHandleSignaled := WaitForMultipleObjects(3, @HandlesToWaitFor,
      False, INFINITE);

          // Which event occured?
    case dwHandleSignaled of
      WAIT_OBJECT_0:                    // Signal to end the thread.
        begin
                    // Time to exit.
          goto EndReadThread
        end;

      WAIT_OBJECT_0 + 1:                // CommEvent signaled.
        begin
                    // Handle the CommEvent.
          if not HandleCommEvent(@overlappedCommEvent, fdwEvtMask, TRUE) then
            goto EndReadThread;

                    // Start waiting for the next CommEvent.
          if not SetupCommEvent(@overlappedCommEvent, fdwEvtMask) then
            goto EndReadThread
                    {break;??}
        end;

      WAIT_OBJECT_0 + 2:                // Read Event signaled.
        begin
                    // Get the new data!
          if not HandleReadEvent(@overlappedRead,
            szInputBuffer,
            INPUTBUFFERSIZE,
            nNumberOfBytesRead) then
            goto EndReadThread;

                    // Wait for more new data.
          if not SetupReadEvent(@overlappedRead,
            szInputBuffer, INPUTBUFFERSIZE,
            nNumberOfBytesRead) then
            goto EndReadThread
                    {break;}
        end;

      WAIT_FAILED:                      // Wait failed.  Shouldn't happen.
        begin
          PostHangupCall;
          goto EndReadThread
        end
    else                                // This case should never occur.
      begin
        PostHangupCall;
        goto EndReadThread
      end
    end                                 {case dwHandleSignaled}
  end;                                  {while True}

        // Time to clean up Read Thread.
  EndReadThread:

  PurgeComm(hCommFile, PURGE_RXABORT + PURGE_RXCLEAR);
  CloseHandle(overlappedRead.hEvent);
  CloseHandle(overlappedCommEvent.hEvent)
end;                                    {TReadThread.Execute}

//
//  FUNCTION: SetupReadEvent(LPOVERLAPPED, LPSTR, DWORD, LPDWORD)
//
//  PURPOSE: Sets up an overlapped ReadFile
//
//  PARAMETERS:
//    lpOverlappedRead      - address of overlapped structure to use.
//    lpszInputBuffer       - Buffer to place incoming bytes.
//    dwSizeofBuffer        - size of lpszInputBuffer.
//    lpnNumberOfBytesRead  - address of DWORD to place the number of read bytes.
//
//  RETURN VALUE:
//    TRUE if able to successfully setup the ReadFile.  FALSE if there
//    was a failure setting up or if the CloseEvent object was signaled.
//
//  COMMENTS:
//
//    This function is a helper function for the Read Thread.  This
//    function sets up the overlapped ReadFile so that it can later
//    be waited on (or more appropriatly, so the event in the overlapped
//    structure can be waited upon).  If there is data waiting, it is
//    handled and the next ReadFile is initiated.
//    Another possible reason for returning FALSE is if the comm port
//    is closed by the service provider.
//
//
//

function TReadThread.SetupReadEvent(lpOverlappedRead: POverlapped;
  lpszInputBuffer: LPSTR; dwSizeofBuffer: DWORD;
  var lpnNumberOfBytesRead: DWORD): Boolean;
var
  dwLastError  : DWORD;
label
  StartSetupReadEvent;
begin
  Result := False;

  StartSetupReadEvent:

     // Make sure the CloseEvent hasn't been signaled yet.
     // Check is needed because this function is potentially recursive.
  if WAIT_TIMEOUT <> WaitForSingleObject(hCloseEvent, 0) then
    Exit;

     // Start the overlapped ReadFile.
  if ReadFile(hCommFile,
    lpszInputBuffer^, dwSizeofBuffer,
    lpnNumberOfBytesRead, lpOverlappedRead) then
  begin
          // This would only happen if there was data waiting to be read.

          // Handle the data.
    if not HandleReadData(lpszInputBuffer, lpnNumberOfBytesRead) then
      Exit;

          // Start waiting for more data.
    goto StartSetupReadEvent
  end;

     // ReadFile failed.  Expected because of overlapped I/O.
  dwLastError := GetLastError;

     // LastError was ERROR_IO_PENDING, as expected.
  if dwLastError = ERROR_IO_PENDING then
  begin
    Result := True;
    Exit
  end;

     // Its possible for this error to occur if the
     // service provider has closed the port.  Time to end.
  if dwLastError = ERROR_INVALID_HANDLE then
    Exit;

     // Unexpected error come here. No idea what could cause this to happen.
  PostHangupCall
end;                                    {TReadThread.SetupReadEvent}

//
//  FUNCTION: HandleReadData(LPCSTR, DWORD)
//
//  PURPOSE: Deals with data after its been read from the comm file.
//
//  PARAMETERS:
//    lpszInputBuffer  - Buffer to place incoming bytes.
//    dwSizeofBuffer   - size of lpszInputBuffer.
//
//  RETURN VALUE:
//    TRUE if able to successfully handle the data.
//    FALSE if unable to allocate memory or handle the data.
//
//  COMMENTS:
//
//    This function is yet another helper function for the Read Thread.
//    It LocalAlloc()s a buffer, copies the new data to this buffer and
//    calls PostWriteToDisplayCtl to let the EditCtls module deal with
//    the data.  Its assumed that PostWriteToDisplayCtl posts the message
//    rather than dealing with it right away so that the Read Thread
//    is free to get right back to waiting for data.  Its also assumed
//    that the EditCtls module is responsible for LocalFree()ing the
//    pointer that is passed on.
//
//

function TReadThread.HandleReadData(lpszInputBuffer: LPCSTR; dwSizeofBuffer:
  DWORD): Boolean;
var
  lpszPostedBytes: LPSTR;
begin
  Result := False;

     // If we got data and didn't just time out empty...
  if dwSizeofBuffer <> 0 then
  begin
          // Do something with the bytes read.

    lpszPostedBytes := PChar(LocalAlloc(LPTR, dwSizeofBuffer + 1));

    if lpszPostedBytes = nil {NULL} then
    begin
               // Out of memory

      PostHangupCall;
      Exit
    end;

    Move(lpszInputBuffer^, lpszPostedBytes^, dwSizeofBuffer);
    lpszPostedBytes[dwSizeofBuffer] := #0;

    Result := ReceiveData(lpszPostedBytes, dwSizeofBuffer)
  end
end;                                    {TReadThread.HandleReadData}

//
//  FUNCTION: HandleReadEvent(LPOVERLAPPED, LPSTR, DWORD, LPDWORD)
//
//  PURPOSE: Retrieves and handles data when there is data ready.
//
//  PARAMETERS:
//    lpOverlappedRead      - address of overlapped structure to use.
//    lpszInputBuffer       - Buffer to place incoming bytes.
//    dwSizeofBuffer        - size of lpszInputBuffer.
//    lpnNumberOfBytesRead  - address of DWORD to place the number of read bytes.
//
//  RETURN VALUE:
//    TRUE if able to successfully retrieve and handle the available data.
//    FALSE if unable to retrieve or handle the data.
//
//  COMMENTS:
//
//    This function is another helper function for the Read Thread.  This
//    is the function that is called when there is data available after
//    an overlapped ReadFile has been setup.  It retrieves the data and
//    handles it.
//
//

function TReadThread.HandleReadEvent(lpOverlappedRead: POverlapped;
  lpszInputBuffer: LPSTR; dwSizeofBuffer: DWORD;
  var lpnNumberOfBytesRead: DWORD): Boolean;
var
  dwLastError  : DWORD;
begin
  Result := False;

  if GetOverlappedResult(hCommFile,
    lpOverlappedRead^, lpnNumberOfBytesRead, False) then
  begin
    Result := HandleReadData(lpszInputBuffer, lpnNumberOfBytesRead);
    Exit
  end;

     // Error in GetOverlappedResult; handle it.

  dwLastError := GetLastError;

     // Its possible for this error to occur if the
     // service provider has closed the port.  Time to end.
  if dwLastError = ERROR_INVALID_HANDLE then
    Exit;

     // Unexpected error come here. No idea what could cause this to happen.
  PostHangupCall
end;                                    {TReadThread.HandleReadEvent}

//
//  FUNCTION: SetupCommEvent(LPOVERLAPPED, LPDWORD)
//
//  PURPOSE: Sets up the overlapped WaitCommEvent call.
//
//  PARAMETERS:
//    lpOverlappedCommEvent - Pointer to the overlapped structure to use.
//    lpfdwEvtMask          - Pointer to DWORD to received Event data.
//
//  RETURN VALUE:
//    TRUE if able to successfully setup the WaitCommEvent.
//    FALSE if unable to setup WaitCommEvent, unable to handle
//    an existing outstanding event or if the CloseEvent has been signaled.