xcomdrv.pas

delphi串口通讯控件,简单易用

var Overlapped: TOverlapped;
    BytesWritten: dword;
begin
  FillChar(Overlapped, SizeOf(Overlapped), 0);
  Overlapped.hEvent := CreateEvent(nil, True, True, nil);
  WriteFile(Handle, Buffer, Count, BytesWritten, @Overlapped);
  WaitForSingleObject(Overlapped.hEvent, INFINITE);
  if not GetOverlappedResult(Handle, Overlapped, BytesWritten, False) then
    XCommWin32Error( SSendError, DEC_SENDERROR );
  CloseHandle(Overlapped.hEvent);
  Result := BytesWritten;
end;

{===> Alex}
function intRead(Handle: THandle; var Buffer; Count: dword): dword;
var Overlapped: TOverlapped;
    BytesRead: dword;
begin
  FillChar(Overlapped, SizeOf(Overlapped), 0);
  Overlapped.hEvent := CreateEvent(nil, True, True, nil);
  ReadFile(Handle, Buffer, Count, BytesRead, @Overlapped);
  WaitForSingleObject(Overlapped.hEvent, INFINITE);
  if not GetOverlappedResult(Handle, Overlapped, BytesRead, False) then
    XCommWin32Error( SReadError, DEC_READERROR );
  CloseHandle(Overlapped.hEvent);
  Result := BytesRead;
end;

function TCustomComm.SendDataEx( const Data; DataSize, Timeout: DWORD ): DWORD;
var nToSend, nSent, t1: DWORD;
    DataPtr: PChar;
begin
  Result := 0;

  if not Opened then
  begin
    XCommError(SCommClosed, DEC_CLOSED);
    Exit;
  end;

  if loSend in Locked then
  begin
    XCommError(SLockedSend, DEC_LOCKEDSEND);
    Exit;
  end;

  if (DataSize=0) then Exit;

  DataPtr:=@Data;
  t1 := GetTickCount;
  while DataSize > 0 do
  begin
    nToSend := FBuffers.FOutputSize - OutCount;
    if nToSend > 0 then
    begin
      if nToSend > DataSize then nToSend := DataSize;
      nSent := intSend(FHandle, DataPtr^, nToSend);
      UpdateEvents([deOutEmpty]);
      if nSent > 0 then
      begin
        Inc(FTotalSent, nSent);
        Inc(Result, nSent);
        Dec(DataSize, nSent);
        DataPtr := DataPtr + nSent;
        Include(FLocked, loSend);
        try
          if Assigned(FOnSend) then FOnSend(Self);
        finally
          Exclude(FLocked, loSend);
        end;
        continue;
      end;
    end;
    if (GetTickCount-t1>Timeout) then break;
  end;
end;

function TCustomComm.SendData( const Data; DataSize: DWORD ): DWORD;
begin
  Result := SendDataEx(Data, DataSize, FBuffers.OutputTimeout);
end;

function TCustomComm.SendByte( const Value: byte ): boolean;
begin
  Result := SendData(Value, 1) = 1;
end;

function TCustomComm.SendString( const Value: string ): boolean;
begin
  Result := SendData(Value[1], Length(Value)) = DWORD(Length(Value));
end;

function TCustomComm.ReadDataEx( var Data; MaxDataSize, Timeout: DWORD ): DWORD;
var nToRead, nRead, t1: DWORD;
    DataPtr: PChar;
begin
  Result := 0;
  if not Opened then
  begin
    XCommError(SCommClosed, DEC_CLOSED);
    Exit;
  end;

  if loRead in Locked then
  begin
    XCommError(SLockedRead, DEC_LOCKEDREAD);
    Exit;
  end;

  if (MaxDataSize=0) then Exit;

  DataPtr:=@Data;
  t1 := GetTickCount;
  while MaxDataSize > 0 do
  begin
    nToRead := InCount;
    if nToRead > 0 then
    begin
      if nToRead > MaxDataSize then nToRead := MaxDataSize;
      nRead := intRead(FHandle, DataPtr^, nToRead);
      Inc(FTotalRead, nRead);
      Result := Result + nRead;
      MaxDataSize := MaxDataSize - nRead;
      DataPtr := DataPtr + nRead;
      Include(FLocked, loRead);
      try
        if (nRead>0) and Assigned(FOnRead) then
          FOnRead(Self);
      finally
        Exclude(FLocked, loRead);
      end;
      continue;
    end;
    if (GetTickCount-t1>Timeout) then break;
  end;
end;

function TCustomComm.ReadData( var Data; MaxDataSize: DWORD ): DWORD;
begin
  Result := ReadDataEx(Data, MaxDataSize, FBuffers.InputTimeout);
end;

function TCustomComm.ReadByte( var Value: byte ): boolean;
begin
  Result := ReadData(Value, 1) = 1;
end;

function TCustomComm.ReadString( var Value: string ): boolean;
var nRead: DWORD;
begin
  SetLength(Value, InCount);
  nRead := ReadData(Value[1], Length(Value));
  SetLength(Value, nRead);
  Result := (nRead>0);
end;

function TCustomComm.ReadString( var Value: string; Len: integer ): boolean;
begin
  Result:=(DWORD(Len)<=InCount) and (Len>0);
  if Result then
  begin
    SetLength(Value, Len);
    Result := ReadData(Value[1], Len) = DWORD(Len);
  end;
end;

procedure TCustomComm.UpdateEvents( Events: TDeviceEvents );
var I: integer;
begin
  if not Opened or (csDestroying in ComponentState) then Exit;
  for I:=0 to PluginCount-1 do
    if esBefore in Plugins[I].EventState then Plugins[I].HandleEvents(Events);
  HandleEvents(Events);
  for I:=0 to PluginCount-1 do
    if esAfter in Plugins[I].EventState then Plugins[I].HandleEvents(Events);
end;

procedure TCustomComm.HandleEvents( Events: TDeviceEvents );
begin
  if (deChar in Events) or (deFlag in Events) then ReceiveData(InCount);
  if (FPaused=0) and Assigned(FOnCommEvent) and (Events*FEvents<>[]) then
    FOnCommEvent(Self, Events*FEvents);
end;

procedure TCustomComm.ReceiveData( Received: DWORD );
begin
  if (FPaused=0) and Assigned(FOnData) then FOnData(Self, Received);
end;

procedure TCustomComm.ToggleBreak( Status: TBreakStatus );
const func_: array[TBreakStatus] of integer = ( CLRBREAK, SETBREAK );
begin
  if Opened
    then EscapeCommFunction(FHandle, func_[Status])
    else XCommError(SCommClosed, DEC_CLOSED);
end;

procedure TCustomComm.ToggleDTR( Status: TBreakStatus );
const func_: array[TBreakStatus] of integer = ( CLRDTR, SETDTR );
begin
  if Opened
    then EscapeCommFunction(FHandle, func_[Status])
    else XCommError(SCommClosed, DEC_CLOSED);
end;

procedure TCustomComm.ToggleRTS( Status: TBreakStatus );
const func_: array[TBreakStatus] of integer = ( CLRRTS, SETRTS );
begin
  if Opened
    then EscapeCommFunction(FHandle, func_[Status])
    else XCommError(SCommClosed, DEC_CLOSED);
end;

procedure TCustomComm.ToggleXonXoff( Status: TBreakStatus);
const func_: array[TBreakStatus] of integer = (SETXOFF,SETXON);
begin
  if Opened
    then EscapeCommFunction( FHandle, func_[Status])
    else XCommError(SCommClosed, DEC_CLOSED);
end;


function TCustomComm.WaitForString( const Value: array of string;
  Timeout: DWORD ): integer;
var ch: char;
    Data: string;
    t: DWORD;
    i, nOut: integer;
begin
  Result := -1;
  if not Opened then
  begin
    XCommError(SCommClosed, DEC_CLOSED);
    Exit;
  end;
  if loRead in Locked then
  begin
    XCommError(SLockedRead, DEC_LOCKEDREAD);
    Exit;
  end;
  if (High(Value)=-1) then Exit;
  Paused := True;
  try
    t:=GetTickCount;
    Data:='';
    nOut := 0;
    repeat
      if (ReadDataEx(ch, 1, 0)=1) then
      begin
        Data:=Data+ch;
        for i:=0 to High(Value) do
        if (Pos(Value[i], Data)>0) then
        begin
          Result := i;
          Break;
        end;
        Inc(nOut);
        if (nOut<10) and (InCount>0) then Continue;
      end;
      nOut := 0;
      if (Timeout>0) and (GetTickCount-t>=Timeout) then Break;
    until (Result<>-1) or Application.Terminated or not Opened;
  finally
    Paused := False;
  end;
end;

procedure TCustomComm.InternalAsyncProc( Success: boolean; Data: pointer; Count: integer );
begin
  if Success and (Data=nil) then
  begin
    Inc(FTotalSent, Count);
    if Assigned(FOnSend) then FOnSend(Self);
  end else if Success then
  begin
    Inc(FTotalRead, Count);
    if Assigned(FOnRead) then FOnRead(Self);
  end;
  if Assigned(FSavedAsyncProc) then
    FSavedAsyncProc(Success, Data, Count);
end;

function TCustomComm.InitAsync( AsyncProc: TAsyncProc; AutoClose: boolean ): HASYNC;
begin
  Result := 0;
  FSavedAsyncProc := AsyncProc;
  if Opened then
    Result := InternalInitAsync(FHandle, InternalAsyncProc, AutoClose)
  else
    XCommError(SCommClosed, DEC_CLOSED);
end;

function TCustomComm.CloseAsync( Async: HASYNC ): boolean;
begin
  Result := InternalCloseAsync(Async);
end;

function TCustomComm.SendAsync( Async: HASYNC; const Data; DataSize: DWORD ): DWORD;
begin
  Result := 0;
  if Opened then
  begin
    if loSend in Locked then
      XCommError(SLockedSend, DEC_LOCKEDSEND)
    else
    begin
      Result := InternalWriteAsync(Async, Data, DataSize);
      UpdateEvents([deOutEmpty]);
    end;
  end else
    XCommError(SCommClosed, DEC_CLOSED);
end;

function TCustomComm.SendStringAsync( Async: HASYNC; const Value: string ): DWORD;
begin
  Result := 0;
  if Opened then
  begin
    if loSend in Locked then
      XCommError(SLockedSend, DEC_LOCKEDSEND)
    else if Length(Value)>0 then
    begin
      Result := InternalWriteAsync(Async, Value[1], Length(Value));
      UpdateEvents([deOutEmpty]);
    end;
  end else
    XCommError(SCommClosed, DEC_CLOSED);
end;

function TCustomComm.ReadAsync( Async: HASYNC; var Data; DataSize: DWORD ): DWORD;
begin
  Result := 0;
  if Opened then
  begin
    if loRead in Locked then
      XCommError(SLockedRead, DEC_LOCKEDREAD)
    else
      Result := InternalReadAsync(Async, Data, DataSize);
  end else
    XCommError(SCommClosed, DEC_CLOSED);
end;

function TCustomComm.ReadStringAsync( Async: HASYNC; var Value: string ): DWORD;
begin
  Result := 0;
  if Opened then
  begin
    if loRead in Locked then
      XCommError(SLockedRead, DEC_LOCKEDREAD)
    else
      Result := InternalReadStringAsync(Async, Value);
  end else
    XCommError(SCommClosed, DEC_CLOSED);
end;

function TCustomComm.WaitAsync( Async: HASYNC; Process: TWaitProc ): boolean;
begin
  Result := False;
  if Opened then
    Result := InternalWaitAsync(Async, Process)
  else
    XCommError(SCommClosed, DEC_CLOSED);
end;

function TCustomComm.GetLocked: TLockState;
  function PluginLocked: TLockState;
  var I: integer;
  begin
    Result := FLocked;
    for I:=0 to PluginCount-1 do
    begin
      Result := Result + Plugins[I].LockState;
      if Result = [loRead, loSend] then Exit;
    end;
  end;
begin
  Result := [loRead, loSend];
  if Opened then Result := PluginLocked;
end;

{-- TModemSettings --}

constructor TModemSettings.Create;
begin
  inherited Create;
  FConnectType   := ctDial;
  FDialNumber    := '';
  FDialType      := dtTone;
  FInitString    := 'ATX&C1&D2&K3M0';
  FResetString   := 'ATZ';
  FSpeed         := 33600;
  FWaitRings     := 2;
end;

procedure TModemSettings.AssignTo( Dest: TPersistent );
begin
  if (Dest is TModemSettings) then
  begin
    FInitString  := TModemSettings(Dest).InitString;
    FResetString := TModemSettings(Dest).ResetString;
    FSpeed       := TModemSettings(Dest).Speed;
    FDialType    := TModemSettings(Dest).DialType;
    FDialNumber  := TModemSettings(Dest).DialNumber;
    FConnectType := TModemSettings(Dest).ConnectType;
    FWaitRings   := TModemSettings(Dest).WaitRings;
  end
  else
    inherited AssignTo(Dest);
end;

procedure TModemSettings.SetSpeed( Value: Longint );
begin
  case Value of
    0, 2400, 4800, 7200, 9600, 12000, 14400, 16800,
    19200, 21600, 24000, 26400, 28800, 31200, 33600,
    56000, 57600 : FSpeed := Value;
  end;
end;

{-- TCustomModem support--}
const
  MRC_: array [0..7] of string =
    ( 'OK', 'CONNECT', 'RING', 'NO CARRIER','ERROR', 'NO DIALTONE', 'BUSY',
     'NO ANSWER' );