spcomm.pas

主要介绍超市管理系统的后台系统,后台程序是系统初始化和系统维护最常使用的一部分程序,主要任务是建产基本数据,进出货盘点和打印报表.后台程序主要负责的都是管理上的功能,当后台建立完整的数据后,前台才能顺

     // If this fails, it could be because the file was closed (and I/O is
     // finished) or because the overlapped I/O is still in progress.  In
     // either case (or any others) its a bug and return FALSE.
     if fRetrieveEvent then
     begin
          if not GetOverlappedResult( hCommFile,
                                      lpOverlappedCommEvent^, dwDummy, False ) then
          begin
               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;

               PostHangupCall;
               Exit
          end
     end;

     // Was the event an error?
     if (lpfdwEvtMask and EV_ERR) <> 0 then
     begin
          // Which error was it?
          if not ClearCommError( hCommFile, dwErrors, nil ) then
          begin
               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;

               PostHangupCall;
               Exit
          end;

          // Its possible that multiple errors occured and were handled
          // in the last ClearCommError.  Because all errors were signaled
          // individually, but cleared all at once, pending comm events
          // can yield EV_ERR while dwErrors equals 0.  Ignore this event.

          if not ReceiveError( dwErrors ) then
             Exit;

          Result := True
     end;

     dwModemEvent := 0;

     if ((lpfdwEvtMask and EV_RLSD) <> 0) then
        dwModemEvent := ME_RLSD;
     if ((lpfdwEvtMask and EV_RING) <> 0) then
        dwModemEvent := dwModemEvent or ME_RING;

     if dwModemEvent <> 0 then
     begin
          if not ModemStateChange( dwModemEvent ) then
          begin
               Result := False;
               Exit
          end;

          Result := True
     end;

     if ((lpfdwEvtMask and EV_ERR)=0) and (dwModemEvent=0) then
     begin
          // Should not have gotten here.
          PostHangupCall
     end
end; {TReadThread.HandleCommEvent}

function TReadThread.ReceiveData( lpNewString: LPSTR; dwSizeofNewString: DWORD ): BOOL;
begin
     Result := False;

     if not PostMessage( hComm32Window, PWM_GOTCOMMDATA,
                         WPARAM(dwSizeofNewString), LPARAM(lpNewString) ) then
        PostHangupCall
     else
         Result := True
end;

function TReadThread.ReceiveError( EvtMask : DWORD ): BOOL;
begin
     Result := False;

     if not PostMessage( hComm32Window, PWM_RECEIVEERROR, 0, LPARAM(EvtMask) ) then
        PostHangupCall
     else
         Result := True
end;

function TReadThread.ModemStateChange( ModemEvent : DWORD ) : BOOL;
begin
     Result := False;

     if not PostMessage( hComm32Window, PWM_MODEMSTATECHANGE, 0, LPARAM(ModemEvent) ) then
        PostHangupCall
     else
         Result := True
end;

procedure TReadThread.PostHangupCall;
begin
     PostMessage( hComm32Window, PWM_REQUESTHANGUP, 0, 0 )
end;

(******************************************************************************)
//  WRITE THREAD
(******************************************************************************)

//
//  PROCEDURE: TWriteThread.Execute
//
//  PURPOSE: The starting point for the Write thread.
//
//  PARAMETERS:
//    lpvParam - unused.
//
//  RETURN VALUE:
//    DWORD - unused.
//
//  COMMENTS:
//
//    The Write thread uses a PeekMessage loop to wait for a string to write,
//    and when it gets one, it writes it to the Comm port.  If the CloseEvent
//    object is signaled, then it exits.  The use of messages to tell the
//    Write thread what to write provides a natural desynchronization between
//    the UI and the Write thread.
//
//
procedure TWriteThread.Execute;
var
   msg:   TMsg;
   dwHandleSignaled:      DWORD;
   overlappedWrite:       TOverLapped;
   CompleteOneWriteRequire : Boolean;
label
     EndWriteThread;
begin
     // Needed for overlapped I/O.
     FillChar( overlappedWrite, SizeOf(overlappedWrite), 0 );  {0, 0, 0, 0, NULL}

     overlappedWrite.hEvent := CreateEvent( nil, True, True, nil );
     if overlappedWrite.hEvent = 0 then
     begin
          PostHangupCall;
          goto EndWriteThread
     end;

     CompleteOneWriteRequire := True;

     // This is the main loop.  Loop until we break out.
     while True do
     begin
          if not PeekMessage( msg, 0, 0, 0, PM_REMOVE ) then
          begin
               // If there are no messages pending, wait for a message or
               // the CloseEvent.

               pFSendDataEmpty^ := True;

               if CompleteOneWriteRequire then
               begin
                    if not PostMessage( hComm32Window, PWM_SENDDATAEMPTY, 0, 0 ) then
                    begin
                         PostHangupCall;
                         goto EndWriteThread
                    end
               end;

               CompleteOneWriteRequire := False;

               dwHandleSignaled := MsgWaitForMultipleObjects(1, hCloseEvent, False,
                                   INFINITE, QS_ALLINPUT);

               case dwHandleSignaled of
               WAIT_OBJECT_0:     // CloseEvent signaled!
               begin
                    // Time to exit.
                    goto EndWriteThread
               end;

               WAIT_OBJECT_0 + 1: // New message was received.
               begin
                    // Get the message that woke us up by looping again.
                    Continue
               end;

               WAIT_FAILED:       // Wait failed.  Shouldn't happen.
               begin
                    PostHangupCall;
                    goto EndWriteThread
               end
               
               else                // This case should never occur.
               begin
                    PostHangupCall;
                    goto EndWriteThread
               end
               end
          end;

          // Make sure the CloseEvent isn't signaled while retrieving messages.
          if WAIT_TIMEOUT <> WaitForSingleObject(hCloseEvent,0) then
             goto EndWriteThread;

          // Process the message.
          // This could happen if a dialog is created on this thread.
          // This doesn't occur in this sample, but might if modified.
          if msg.hwnd <> 0{NULL} then
          begin
               TranslateMessage(msg);
               DispatchMessage(msg);
               Continue
          end;

          // Handle the message.
          case msg.message of
          PWM_COMMWRITE:  // New string to write to Comm port.
          begin
               // Write the string to the comm port.  HandleWriteData
               // does not return until the whole string has been written,
               // an error occurs or until the CloseEvent is signaled.
               if not HandleWriteData( @overlappedWrite,
                                       PChar(msg.lParam), DWORD(msg.wParam) ) then
               begin
                    // If it failed, either we got a signal to end or there
                    // really was a failure.

                    LocalFree( HLOCAL(msg.lParam) );
                    goto EndWriteThread
               end;

               CompleteOneWriteRequire := True;
               // Data was sent in a LocalAlloc()d buffer.  Must free it.
               LocalFree( HLOCAL(msg.lParam) )
          end
          end
     end; {main loop}

     // Thats the end.  Now clean up.
EndWriteThread:

     PurgeComm(hCommFile, PURGE_TXABORT + PURGE_TXCLEAR);
     pFSendDataEmpty^ := True;
     CloseHandle(overlappedWrite.hEvent)
end; {TWriteThread.Execute}


//
//  FUNCTION: HandleWriteData(LPOVERLAPPED, LPCSTR, DWORD)
//
//  PURPOSE: Writes a given string to the comm file handle.
//
//  PARAMETERS:
//    lpOverlappedWrite  - Overlapped structure to use in WriteFile
//    pDataToWrite       - String to write.
//    dwNumberOfBytesToWrite - Length of String to write.
//
//  RETURN VALUE:
//    TRUE if all bytes were written.  False if there was a failure to
//    write the whole string.
//
//  COMMENTS:
//
//    This function is a helper function for the Write Thread.  It
//    is this call that actually writes a string to the comm file.
//    Note that this call blocks and waits for the Write to complete
//    or for the CloseEvent object to signal that the thread should end.
//    Another possible reason for returning FALSE is if the comm port
//    is closed by the service provider.
//
//
function TWriteThread.HandleWriteData( lpOverlappedWrite: POverlapped;
         pDataToWrite: PChar; dwNumberOfBytesToWrite: DWORD): Boolean;
var
   dwLastError,

   dwNumberOfBytesWritten,
   dwWhereToStartWriting,

   dwHandleSignaled:       DWORD;
   HandlesToWaitFor: array[0..1] of THandle;
begin
     Result := False;

     dwNumberOfBytesWritten := 0;
     dwWhereToStartWriting := 0; // Start at the beginning.

     HandlesToWaitFor[0] := hCloseEvent;
     HandlesToWaitFor[1] := lpOverlappedWrite^.hEvent;

     // Keep looping until all characters have been written.
     repeat
           // Start the overlapped I/O.
           if not WriteFile( hCommFile,
                             pDataToWrite[ dwWhereToStartWriting ],
                             dwNumberOfBytesToWrite, dwNumberOfBytesWritten,
                             lpOverlappedWrite ) then
           begin
                // WriteFile failed.  Expected; lets 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.  No idea what.
                if dwLastError <> ERROR_IO_PENDING then
                begin
                     PostHangupCall;
                     Exit
                end;

                // This is the expected ERROR_IO_PENDING case.

                // Wait for either overlapped I/O completion,
                // or for the CloseEvent to get signaled.
                dwHandleSignaled := WaitForMultipleObjects(2, @HandlesToWaitFor,
                                    False, INFINITE);

                case dwHandleSignaled of
                WAIT_OBJECT_0:     // CloseEvent signaled!
                begin
                     // Time to exit.
                     Exit
                end;

                WAIT_OBJECT_0 + 1: // Wait finished.
                begin
                     // Time to get the results of the WriteFile
                     if not GetOverlappedResult(hCommFile,
                                           lpOverlappedWrite^,
                                           dwNumberOfBytesWritten, True) then
                     begin
                          dwLastError := GetLastError;

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

                          // No idea what could cause another error.
                          PostHangupCall;
                          Exit
                     end
                end;

                WAIT_FAILED: // Wait failed.  Shouldn't happen.
                begin
                     PostHangupCall;
                     Exit
                end

                else // This case should never occur.
                begin
                     PostHangupCall;
                     Exit
                end
                end {case}
           end; {WriteFile failure}

           // Some data was written.  Make sure it all got written.

           Dec( dwNumberOfBytesToWrite, dwNumberOfBytesWritten );
           Inc( dwWhereToStartWriting, dwNumberOfBytesWritten )
     until (dwNumberOfBytesToWrite <= 0);  // Write the whole thing!

     // Wrote the whole string.
     Result := True
end; {TWriteThread.HandleWriteData}

procedure TWriteThread.PostHangupCall;
begin
     PostMessage( hComm32Window, PWM_REQUESTHANGUP, 0, 0 )
end;

procedure Register;
begin
     RegisterComponents('J_STD', [TComm])
end;

end.