Delphi 一个操作窗口的例子

Title: Access the serial port in Windows XP

Author: Tomas Rutkauskas

Product: Delphi 4.x (or higher)

Post Date: 11/14/2002

Problem/Question/Abstract:

How I do to access the serial or paralell port in Windows XP?

Answer:

The example below sends a char 'R' to the port, then reads a line until CR or LF is encountered, then processes a line via ParseData. Then all is repeated until Terminated is True.

procedure ProcessCOMPortData(FPortName: string);

var

 LPortHandle: THandle;

 LInBuffer: array[0..1023] of Char;

 LBytesWritten, LBytesRead: Cardinal;

 LOutBuffer: Char;

 LOverlapped: TOverlapped;

 LEvent: TEvent;

 LOldCommTimeouts, LCommTimeouts: TCommTimeouts;

 LPCommConfig: PCommConfig;

 LCommConfig: TCommConfig;

 CommConfigSize: Cardinal;

 LEOL: Boolean;

 LIndex: Integer;

begin

 ZeroMemory(@LOverlapped, SizeOf(TOverlapped));

 ZeroMemory(@LCommTimeouts, SizeOf(TCommTimeouts));

 ZeroMemory(@LCommConfig, SizeOf(TCommConfig));

 LPortHandle := INVALID_HANDLE_VALUE;

 LEvent := nil;

 LPCommConfig := nil;

 try

   CommConfigSize := 0;

   LPCommConfig := @LCommConfig;

   GetDefaultCommConfig(PChar(FPortName), LPCommConfig^, CommConfigSize);

   GetMem(LPCommConfig, CommConfigSize);

   GetDefaultCommConfig(PChar(FPortName), LPCommConfig^, CommConfigSize);

   LEvent := TEvent.Create(nil, True, False, '');

   LOverlapped.hEvent := LEvent.Handle;

   LPortHandle := CreateFile(PChar(FPortName), GENERIC_READ or GENERIC_WRITE, 0,

     nil, OPEN_EXISTING, FILE_FLAG_OVERLAPPED, 0);

   if (LPortHandle = INVALID_HANDLE_VALUE) then

     Exit;

   SetCommConfig(LPortHandle, LPCommConfig^, CommConfigSize);

   GetCommTimeouts(LPortHandle, LOldCommTimeouts);

   SetCommTimeouts(LPortHandle, LCommTimeouts);

   while not Terminated do

   begin

     PurgeComm(LPortHandle, PURGE_TXCLEAR or PURGE_RXCLEAR or

       PURGE_RXABORT or PURGE_TXABORT);

     LOutBuffer := 'R';

     WriteFile(LPortHandle, LOutBuffer, Length(LOutBuffer), LBytesWritten,

       @LOverlapped);

     GetOverlappedResult(LPortHandle, LOverlapped, LBytesWritten, True);

     if LBytesWritten = 1 then

     begin

       ZeroMemory(@LInBuffer, SizeOf(LInBuffer));

       ReadFile(LPortHandle, LInBuffer[0], 1, LBytesRead, @LOverlapped);

       case LEvent.WaitFor(50) of

         wrSignaled:

           begin

             GetOverlappedResult(LPortHandle, LOverlapped, LBytesRead, True);

             LEOL := False;

             LIndex := LBytesRead;

             while not LEOL and (LIndex < SizeOf(LInBuffer)) do

             begin

               ReadFile(LPortHandle, LInBuffer[LIndex], 1, LBytesRead, @LOverlapped);

               GetOverlappedResult(LPortHandle, LOverlapped, LBytesRead, True);

               LEOL := (LInBuffer[LIndex] = #$0A) or (LInBuffer[LIndex] = #$0D);

               Inc(LIndex);

             end;

             try

               ParseData(LInBuffer);

             except

             end;

           end;

         wrTimeout, wrAbandoned, wrError:

           begin

             Sleep(100);

           end;

       end;

     end;

   end;

 finally

   SetCommTimeouts(LPortHandle, LOldCommTimeouts);

   CloseHandle(LPortHandle);

   FreeAndNil(LEvent);

   if Assigned(LPCommConfig) then

     FreeMem(LPCommConfig);

 end;

end;