spcomm.pas

其中包含XPMenu控件和SPComm控件

                                     ovOverLapped,
                                     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
              begin
                Exit;
              end;

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

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

          else // This case should never occur.    表示超过规定时间
          begin
            Exit;
          end;
        end; {case}
      end; {WriteFile failure}

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

      Dec( ADataSize, dwNumberOfBytesWritten );
      Inc( dwWhereToStartWriting, dwNumberOfBytesWritten );
      // 如果发送超时
      if DWORD(GetTickCount-t1) > ATimeout then
      begin
        Exit;
      end;
    until (ADataSize <= 0);  // Write the whole thing!

    // Wrote the whole string.
    Result := True;
  finally
    CloseHandle(ovOverLapped.hEvent);
    UseRWThread:=buseRwThread;
  end;
end;{TComm.WriteDataToComm}

(****************************************************************************
 * 函数:   ReadDataFromComm(DataPtr: pchar; DataLen: DWORD; Timeout: DWORD=500);
 * 功能:   供用户读取接收的数据,以字节(十进制)方式的字符串.
 * 作者:   Administrator
 * 日期:   2007-09-25
 * 参数:   DataPtr: pchar; 接收的字符串的存放缓冲区
           DataSize: DWORD;  读取字符串长度
           Timeout: DWORD=500  写超时时间
 * 返回值: Integer  为-1则读时出错,0则未读到数据,大于0则实际读取的数据长度
 * 描述:
 ****************************************************************************)
function TComm.ReadDataFromComm(ADataPtr: pchar; ADataLen: DWORD; ATimeout: DWORD=500): Integer;
var
  bSuccess : Boolean;
  return, read, mask: DWORD;
  dwLastError,
  dwHandleSignaled: DWORD;
  ovOverLapped:        TOverlapped; // Needed for overlapped I/O
  t1: dword;
  cs : COMSTAT;
  inBuffer:       array[0..INPUTBUFFERSIZE-1] of Char; //使用读函数调用方式的读缓冲区
  buseRwThread: Boolean;
begin
	Result := 0;
  return := 0;
	read   := 0; // num read bytes
	mask   := 0; // a 32-bit variable that receives a mask
	                  // indicating the type of event that occurred

	if  ADataLen < 1  then
  begin
    Result := 0;
    Exit;
  end;

  buseRwThread:= UseRWThread;
  UseRWThread:=False;

  FillChar( inBuffer, Sizeof(inBuffer), 0 );  //初始化为0
	// create event for overlapped I/O
  FillChar( ovOverLapped, Sizeof(ovOverLapped), 0 );  //初始化为0
	ovOverLapped.hEvent := CreateEvent(nil,   // pointer to security attributes
	                          FALSE,   // flag for manual-reset event 
	                          FALSE,  // flag for initial state 
	                          '');    // pointer to event-object name

	if ovOverLapped.hEvent = INVALID_HANDLE_VALUE then
	begin
		// Handle the error. "ReadData(): CreateEvent() failed"
		Result := -1 ;
    Exit;
	end;
  try
    //ClearCommError(hCommFile,dwLastError,&ComStat);//检查串口接收缓冲区中的数据个数

    bSuccess := ReadFile(hCommFile, // handle of file to read
                          inBuffer,  // address of buffer that receives data
                          ADataLen,  // number of bytes to read
                          read,     // address of number of bytes read
                          @ovOverLapped); // address of structure for data
    if ( not bSuccess ) then
    begin
      dwLastError :=  GetLastError();
      if (dwLastError=ERROR_IO_PENDING)  then
      begin
        //OutputDebugString("\n\rIO   Pending");
        dwHandleSignaled:= WaitForSingleObject(ovOverLapped.hEvent, ATimeout); //等待Timeout毫秒
        case dwHandleSignaled of                                      // milli seconds before returning
          Wait_Object_0:  GetOverLappedResult(hCommFile,ovOverLapped,read,True);
                             //返回False,出错
          Wait_TimeOut:  //定时溢出
          begin
            //"ReadData(): WaitForSingleObject() failed"
            Result := -1 ;
            Exit;
          end;
          WAIT_FAILED:
          begin
            //"ReadData(): WaitForSingleObject() failed"
            Result := -1 ;
            Exit;
          end;
        end;
      end
      else
      begin
        read := 0;
        ClearCommError( hCommFile, dwLastError, nil );
      end;
    end;
    //PurgeComm(hCommFile, PURGE_RXCLEAR);  // 清除COM 数据
    if read>0 then
      Move(inBuffer, ADataPtr^, read);

    Result:= read;
  finally
    CloseHandle(ovOverLapped.hEvent);
    UseRWThread:=buseRwThread;
  end;
end;{TComm.ReadDataFromComm}

(****************************************************************************
 * 函数:   WriteReadDataFromComm(AWriteDataPtr: PChar; AWriteDataLen: DWORD; AReadDataPtr: PChar; ATimeout: DWORD=500);
 * 功能:
 * 作者:   Administrator
 * 日期:   2007-09-26
 * 参数:   AWriteDataPtr: PChar; AWriteDataLen: DWORD; AReadDataPtr: PChar; ATimeout: DWORD=500
 * 返回值: Integer
 * 描述:
 ****************************************************************************)
function TComm.WriteReadDataFromComm(AWriteDataPtr: PChar; AWriteDataLen: DWORD;
    AReadDataPtr: PChar; ATimeout: DWORD=500): Integer;
var
  ireturn: Integer;
  nBytesRead:            DWORD;
  dwCommError:           DWORD;
  cs:                    TCOMSTAT;
  i, readLen:        DWORD;
  buseRwThread: Boolean;
begin
  Result:= -1;
  ireturn:= -1;
  setInDataCount(0);//清除输入缓冲区
  buseRwThread:= UseRWThread;
  UseRWThread:=False;
  try
    if WriteDataToComm(AWriteDataPtr,AWriteDataLen,ATimeout) then
    begin
      sleep(100);
      //使用ClearCommError得知有多少的数据在缓冲区中, 并得知错误种类
      FInputData:='';
      ClearCommError(hCommFile,dwCommError,@CS);  //取得状态
      FCommError:=dwCommError; //错误数值
      if cs.cbInQue <>0 then //若缓冲区有数据，则读取
      begin
        if InputLen=0 then //指定读取的数据数
          readLen:=cs.cbInQue
        else
          readLen:=InputLen;
        if cs.cbInQue > sizeof(FInputBuffer) then
          PurgeComm(hCommFile, PURGE_RXABORT or PURGE_RXCLEAR)  // 清除COM 数据
        else
        begin
          //读取数据
          ireturn:= ReadDataFromComm(FInputBuffer,readLen,InputTimeout);
          if ireturn > 0 then // 接收COM 的数据
          begin
            //设置字节数组长度
            SetLength(FInputByteData,ReadLen);
            //将数据搬到数组中
            for i:=0 to ReadLen-1 do
              FInputByteData[i]:=ord(FInputBuffer[i]);
            //取出数据
            SetLength(FInputData,ReadLen);
            Move(FInputBuffer,pchar(@FInputData[1])^,ReadLen);
            Move(FInputBuffer, AReadDataPtr^, ireturn);
          end;  //ReadFile Loop
        end;//else Loop
      end; //cs.binQue Loop
    end;
    Result:= ireturn;
  finally
    UseRWThread:=buseRwThread;
  end;
end;{TComm.WriteReadDataFromComm}

//procedure TComm.AddToInputBuffer(Buffer: PChar; BufferLength: Word);
//var
//  ba: array[0..INPUTBUFFERSIZE-1] of char;
//  i,inum: Integer;
//begin
//  if FNumberOfBytesRead<>0 then
//  begin
//    Move(Buffer^, ba, BufferLength);
//    if FNumberOfBytesRead + BufferLength > INPUTBUFFERSIZE then
//    begin
//      //从原读缓冲区的起始区删除多出的字节数, 并将剩余的字节前移.
//      inum:= FNumberOfBytesRead + BufferLength-INPUTBUFFERSIZE;
//      for i:=0 to FNumberOfBytesRead-inum-1 do
//        FInputBuffer[i]:= FInputBuffer[i+inum];
//      for i:=0 to BufferLength-1 do
//        FInputBuffer[i+FNumberOfBytesRead-inum]:= ba[i];
//      FInputBuffer[i+FNumberOfBytesRead]:= ba[i];
//      FNumberOfBytesRead:= FNumberOfBytesRead-inum + BufferLength;
//    end
//    else
//    begin
//      for i:=0 to BufferLength-1 do
//        FInputBuffer[i+FNumberOfBytesRead]:= ba[i];
//      FNumberOfBytesRead:= FNumberOfBytesRead + BufferLength;
//    end;
//  end
//  else
//  begin
//    Move(Buffer^, FInputBuffer, BufferLength);
//    FNumberOfBytesRead:= BufferLength;
//  end;
//end;

function TComm.ReadInputData: String;
begin
  if hCommFile=0 then
  begin
    raise Exception.Create('串口未打开!');
  end;
  //决定每一次的指令要返回多少的字符(以Byte为单位)
  ReadProcess;
  Result:=FInputData;
  //SetLength(Result,FNumberOfBytesRead);
  //Move(FInputBuffer,pchar(@Result[1])^,FNumberOfBytesRead);
end;{TComm.ReadInputData}

procedure TComm.SetInDataCount(const Value: DWORD);
begin
  if Value<>0 then Exit;
  PurgeComm(hCommFile, PURGE_RXABORT or PURGE_RXCLEAR)  // 清除COM 数据
end;{TComm.SetInDataCount}

//以下是实际的读取动作
Procedure TComm.ReadProcess;
var
   nBytesRead:            DWORD;
   dwCommError:           DWORD;
   cs:                    TCOMSTAT;
   i, readLen:        DWORD;
begin
  //使用ClearCommError得知有多少的数据在缓冲区中
  //并得知错误种类
  FInputData:='';
  ClearCommError(hCommFile,dwCommError,@CS);  //取得状态
  FCommError:=dwCommError; //错误数值
  if cs.cbInQue <>0 then //若缓冲区有数据，则读取
  begin
    if InputLen=0 then //指定读取的数据数
      ReadLen:=cs.cbInQue
    else
      ReadLen:=InputLen;
    if cs.cbInQue > sizeof(FInputBuffer) then
      PurgeComm(hCommFile, PURGE_RXABORT or PURGE_RXCLEAR)  // 清除COM 数据
    else
    begin
      //读取数据
      if ReadDataFromComm(FInputBuffer,ReadLen,InputTimeout)>0 then // 接收COM 的数据
      begin
        //设置字节数组长度
        SetLength(FInputByteData,ReadLen);
        //将数据搬到数组中
        for i:=0 to ReadLen-1 do
          FInputByteData[i]:=ord(FInputBuffer[i]);
        //取出数据
        SetLength(FInputData,ReadLen);
        Move(FInputBuffer,pchar(@FInputData[1])^,ReadLen);
      end;  //ReadFile Loop
    end;//else Loop
  end; //cs.binQue Loop
end;{TComm.ReadProcess}

//读取数据的字节数
function TComm.ReadInDataCount():DWORD;
var
  CS:          TCOMSTAT;
  dwCommError: DWORD;
begin
  ClearCommError(hCommFile,dwCommError,@CS);  //取得状态
  Result:=CS.cbInQue;
end;

function TComm.ReadCommError: DWORD;
begin
  Result:=FCommError;
end;

{****************************************************************************
** Procedure: GetModemState
** Author:    Administrator
** Date:      23-七月-2007
** Arguments: None
** Result:    DWORD
** PURPOSE: Read the state of modem input pin right now
** PARAMETERS: none
** RETURN VALUE:
**    A DWORD variable containing one or more of following codes:
**    Value       Meaning
**    ----------  -----------------------------------------------------------
**    MS_CTS_ON   The CTS (clear-to-send) signal is on.
**    MS_DSR_ON   The DSR (data-set-ready) signal is on.
**    MS_RING_ON  The ring indicator signal is on.
**    MS_RLSD_ON  The RLSD (receive-line-signal-detect) signal is on.
**    If this comm have bad handle or not yet opened, the return value is 0
** COMMENTS:
**   This member function calls GetCommModemStatus and return its value.
**   Before calling this member function, you must have a successful
**   'StartOpen' call.
****************************************************************************}
function TComm.GetModemState : DWORD;
var
   dwModemState : DWORD;
begin
  if not GetCommModemStatus( hCommFile, dwModemState ) then
    Result := 0
  else
    Result := dwModemState
end;


(******************************************************************************)
//  TComm PROTECTED METHODS
(******************************************************************************)


{****************************************************************************
** Procedure: CloseReadThread