Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
TComportDriver - драйвер последовательного порта

Автор: Marco Cocco

Идет программист по улице. Встречает девушек.
- Девушки, хотите пива?
- Нет!
- Вина?
- Нет!
- Водки?
- Нет!
Программист думает про себя: "Странно, стандартные драйвера не подошли ".

Скачать исходник - 10кб


// -------------------------------------------------------
// | TComportDriver - A Basic Driver for the serial port |
// -------------------------------------------------------
// | © 1997 by Marco Cocco |
// | © 1998 enhanced by Angerer Bernhard |
// | © 2001 enhanced by Christophe Geers |
// -------------------------------------------------------

//I removed the TTimer and inserted a thread (TTimerThread) to simulate
//the function formerly done by the TTimer.TimerEvent.
//Further more the Readstring procedure has been adjusted. As soon as
//some input on the input buffer from the serial port has been detected
//the TTimerThread is supsended until all the data from the input buffer is read
//using the ReadString procedure......well go ahead and check it out for
//yourself.

//Tested with Delphi 6 Profesionnal / Enterprise on Windows 2000.

{$A+,B-,C+,D-,E-,F-,G+,H+,I+,J+,K-, L-,M-,N+,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y-,Z1}
{$MINSTACKSIZE $00004000}
{$MAXSTACKSIZE $00100000}
{$IMAGEBASE $51000000}
{$APPTYPE GUI}
unit ComportDriverThread;

interface

uses
  //Include "ExtCtrl" for the TTimer component.
  Windows, Messages, SysUtils, Classes, Forms, ExtCtrls;

type

TComPortNumber = (pnCOM1,pnCOM2,pnCOM3,pnCOM4);
TComPortBaudRate = (br110,br300,br600,br1200,br2400,br4800,br9600,
  br14400,br19200,br38400,br56000,br57600,br115200);
TComPortDataBits = (db5BITS,db6BITS,db7BITS,db8BITS);
TComPortStopBits = (sb1BITS,sb1HALFBITS,sb2BITS);
TComPortParity = (ptNONE,ptODD,ptEVEN,ptMARK,ptSPACE);
TComportHwHandshaking = (hhNONE,hhRTSCTS);
TComPortSwHandshaking = (shNONE,shXONXOFF);

TTimerThread = class(TThread)
  private
    { Private declarations }
    FOnTimer : TThreadMethod;
    FEnabled: Boolean;
  protected
    { Protected declarations }
    procedure Execute; override;
    procedure SupRes;
  public
    { Public declarations }
  published
    { Published declarations }
    property Enabled: Boolean read FEnabled write FEnabled;
end;

TComportDriverThread = class(TComponent)
  private
    { Private declarations }
    FTimer : TTimerThread;
    FOnReceiveData : TNotifyEvent;
    FReceiving : Boolean;
  protected
    { Protected declarations }
    FComPortActive : Boolean;
    FComportHandle : THandle;
    FComportNumber : TComPortNumber;
    FComportBaudRate : TComPortBaudRate;
    FComportDataBits : TComPortDataBits;
    FComportStopBits : TComPortStopBits;
    FComportParity : TComPortParity;
    FComportHwHandshaking : TComportHwHandshaking;
    FComportSwHandshaking : TComPortSwHandshaking;
    FComportInputBufferSize : Word;
    FComportOutputBufferSize : Word;
    FComportPollingDelay : Word;
    FTimeOut : Integer;
    FTempInputBuffer : Pointer;
    procedure SetComPortActive(Value: Boolean);
    procedure SetComPortNumber(Value: TComPortNumber);
    procedure SetComPortBaudRate(Value: TComPortBaudRate);
    procedure SetComPortDataBits(Value: TComPortDataBits);
    procedure SetComPortStopBits(Value: TComPortStopBits);
    procedure SetComPortParity(Value: TComPortParity);
    procedure SetComPortHwHandshaking(Value: TComportHwHandshaking);
    procedure SetComPortSwHandshaking(Value: TComPortSwHandshaking);
    procedure SetComPortInputBufferSize(Value: Word);
    procedure SetComPortOutputBufferSize(Value: Word);
    procedure SetComPortPollingDelay(Value: Word);
    procedure ApplyComPortSettings;
    procedure TimerEvent; virtual;
    procedure doDataReceived; virtual;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    function Connect: Boolean;
    function Disconnect: Boolean;
    function Connected: Boolean;
    function Disconnected: Boolean;
    function SendData(DataPtr: Pointer; DataSize: Integer): Boolean;
    function SendString(Input: string): Boolean;
    function ReadString(var Str: string): Integer;
  published
    { Published declarations }
    property Active: Boolean read FComPortActive write SetComPortActive default False;
    property ComPort: TComPortNumber read FComportNumber write SetComportNumber
    default pnCOM1;
    property ComPortSpeed: TComPortBaudRate read FComportBaudRate write
    SetComportBaudRate default br9600;
    property ComPortDataBits: TComPortDataBits read FComportDataBits write
    SetComportDataBits default db8BITS;
    property ComPortStopBits: TComPortStopBits read FComportStopBits write
    SetComportStopBits default sb1BITS;
    property ComPortParity: TComPortParity read FComportParity write
    SetComportParity default ptNONE;
    property ComPortHwHandshaking: TComportHwHandshaking read FComportHwHandshaking
    write SetComportHwHandshaking default
    hhNONE;
    property ComPortSwHandshaking: TComPortSwHandshaking read FComportSwHandshaking
    write SetComportSwHandshaking default
    shNONE;
    property ComPortInputBufferSize: Word read FComportInputBufferSize
    write SetComportInputBufferSize default
    2048;
    property ComPortOutputBufferSize: Word read FComportOutputBufferSize
    write SetComportOutputBufferSize default
    2048;
    property ComPortPollingDelay: Word read FComportPollingDelay write
    SetComportPollingDelay default 100;
    property OnReceiveData: TNotifyEvent read FOnReceiveData
    write FOnReceiveData;
    property TimeOut: Integer read FTimeOut write FTimeOut default 30;
end;

procedure register;

implementation

procedure register;
begin
  RegisterComponents('Self-made Components', [TComportDriverThread]);
end;

{ TComportDriver }

constructor TComportDriverThread.Create(AOwner: TComponent);
begin
  inherited;
  FReceiving := False;
  FComportHandle := 0;
  FComportNumber := pnCOM1;
  FComportBaudRate := br9600;
  FComportDataBits := db8BITS;
  FComportStopBits := sb1BITS;
  FComportParity := ptNONE;
  FComportHwHandshaking := hhNONE;
  FComportSwHandshaking := shNONE;
  FComportInputBufferSize := 2048;
  FComportOutputBufferSize := 2048;
  FOnReceiveData := nil;
  FTimeOut := 30;
  FComportPollingDelay := 500;
  GetMem(FTempInputBuffer,FComportInputBufferSize);

  if csDesigning in ComponentState then
    Exit;

  FTimer := TTimerThread.Create(False);
  FTimer.FOnTimer := TimerEvent;

  if FComPortActive then
    FTimer.Enabled := True;
  FTimer.SupRes;
end;

destructor TComportDriverThread.Destroy;
begin
  Disconnect;
  FreeMem(FTempInputBuffer,FComportInputBufferSize);
  inherited Destroy;
end;

function TComportDriverThread.Connect: Boolean;
var
  comName: array[0..4] of Char;
  tms: TCommTimeouts;
begin
  if Connected then
    Exit;
  StrPCopy(comName,'COM');
  comName[3] := chr(ord('1') + ord(FComportNumber));
  comName[4] := #0;
  FComportHandle := CreateFile(comName,GENERIC_READ or GENERIC_WRITE,0,nil,
  OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0);
  if not Connected then
    Exit;
  ApplyComPortSettings;
  tms.ReadIntervalTimeout := 1;
  tms.ReadTotalTimeoutMultiplier := 0;
  tms.ReadTotalTimeoutConstant := 1;
  tms.WriteTotalTimeoutMultiplier := 0;
  tms.WriteTotalTimeoutConstant := 0;
  SetCommTimeouts(FComportHandle,tms);
  Sleep(1000);
end;

function TComportDriverThread.Connected: Boolean;
begin
  Result := FComportHandle > 0;
end;

function TComportDriverThread.Disconnect: Boolean;
begin
  Result := False;
  if Connected then
  begin
    CloseHandle(FComportHandle);
    FComportHandle := 0;
  end;
  Result := True;
end;

function TComportDriverThread.Disconnected: Boolean;
begin
  if (FComportHandle <> 0) then
    Result := False
  else
    Result := True;
end;

const
  Win32BaudRates: array[br110..br115200] of DWORD =
  (CBR_110,CBR_300,CBR_600,CBR_1200, CBR_2400,CBR_4800,CBR_9600,CBR_14400,
  CBR_19200,CBR_38400,CBR_56000,CBR_57600,CBR_115200);

const
  dcb_Binary = $00000001;
  dcb_ParityCheck = $00000002;
  dcb_OutxCtsFlow = $00000004;
  dcb_OutxDsrFlow = $00000008;
  dcb_DtrControlMask = $00000030;
  dcb_DtrControlDisable = $00000000;
  dcb_DtrControlEnable = $00000010;
  dcb_DtrControlHandshake = $00000020;
  dcb_DsrSensitvity = $00000040;
  dcb_TXContinueOnXoff = $00000080;
  dcb_OutX = $00000100;
  dcb_InX = $00000200;
  dcb_ErrorChar = $00000400;
  dcb_NullStrip = $00000800;
  dcb_RtsControlMask = $00003000;
  dcb_RtsControlDisable = $00000000;
  dcb_RtsControlEnable = $00001000;
  dcb_RtsControlHandshake = $00002000;
  dcb_RtsControlToggle = $00003000;
  dcb_AbortOnError = $00004000;
  dcb_Reserveds = $FFFF8000;

procedure TComportDriverThread.ApplyComPortSettings;
var
  //Device Control Block (= dcb)
  dcb: TDCB;
begin
  if not Connected then
    Exit;
  FillChar(dcb,sizeOf(dcb),0);
  dcb.DCBlength := sizeOf(dcb);

  dcb.Flags := dcb_Binary or dcb_RtsControlEnable;
  dcb.BaudRate := Win32BaudRates[FComPortBaudRate];

  case FComportHwHandshaking of
    hhNONE : ;
    hhRTSCTS:
    dcb.Flags := dcb.Flags or dcb_OutxCtsFlow or dcb_RtsControlHandshake;
  end;

  case FComportSwHandshaking of
    shNONE : ;
    shXONXOFF:
    dcb.Flags := dcb.Flags or dcb_OutX or dcb_Inx;
  end;

  dcb.XonLim := FComportInputBufferSize div 4;
  dcb.XoffLim := 1;
  dcb.ByteSize := 5 + ord(FComportDataBits);
  dcb.Parity := ord(FComportParity);
  dcb.StopBits := ord(FComportStopBits);
  dcb.XonChar := #17;
  dcb.XoffChar := #19;
  SetCommState(FComportHandle,dcb);
  SetupComm(FComportHandle, FComPortInputBufferSize,FComPortOutputBufferSize);
end;

function TComportDriverThread.ReadString(var Str: string): Integer;
var
  BytesTrans, nRead: DWORD;
  Buffer : string;
  i : Integer;
  temp : string;
begin
  BytesTrans := 0;
  Str := '';
  SetLength(Buffer,1);
  ReadFile(FComportHandle,PChar(Buffer)^, 1, nRead, nil);
  while nRead > 0 do
  begin
    temp := temp + PChar(Buffer);
    ReadFile(FComportHandle,PChar(Buffer)^, 1, nRead, nil);
  end;
  //Remove the end token.
  BytesTrans := Length(temp);
  SetLength(str,BytesTrans-2);
  for i:=0 to BytesTrans-2 do
  begin
    str[i] := temp[i];
  end;

  Result := BytesTrans;
end;

function TComportDriverThread.SendData(DataPtr: Pointer;
DataSize: Integer): Boolean;
var
  nsent : DWORD;
begin
  Result := WriteFile(FComportHandle,DataPtr^,DataSize,nsent,nil);
  Result := Result and (nsent = DataSize);
end;

function TComportDriverThread.SendString(Input: string): Boolean;
begin
  if not Connected then
    if not Connect then
      raise Exception.CreateHelp('Could not connect to COM-port !',101);
  Result := SendData(PChar(Input),Length(Input));
  if not Result then
    raise Exception.CreateHelp('Could not send to COM-port !',102);
end;

procedure TComportDriverThread.TimerEvent;
var
  InQueue, OutQueue: Integer;
  Buffer : string;
  nRead : DWORD;

  procedure DataInBuffer(Handle: THandle; var aInQueue, aOutQueue: Integer);
  var
    ComStat : TComStat;
    e : Cardinal;
  begin
    aInQueue := 0;
    aOutQueue := 0;
    if ClearCommError(Handle,e,@ComStat) then
    begin
      aInQueue := ComStat.cbInQue;
      aOutQueue := ComStat.cbOutQue;
    end;
  end;

begin
  if csDesigning in ComponentState then
    Exit;
  if not Connected then
    if not Connect then
      raise Exception.CreateHelp('TimerEvent: Could not connect to COM-port !',101);
  Application.ProcessMessages;
  if Connected then
  begin
    DataInBuffer(FComportHandle,InQueue,OutQueue);
    if InQueue > 0 then
    begin
      if (Assigned(FOnReceiveData) ) then
      begin
        FReceiving := True;
        FOnReceiveData(Self);
      end;
    end;
  end;
end;

procedure TComportDriverThread.SetComportBaudRate(Value: TComPortBaudRate);
begin
  FComportBaudRate := Value;
  if Connected then
    ApplyComPortSettings;
end;

procedure TComportDriverThread.SetComportDataBits(Value: TComPortDataBits);
begin
  FComportDataBits := Value;
  if Connected then
    ApplyComPortSettings;
end;

procedure TComportDriverThread.SetComportHwHandshaking(Value: TComportHwHandshaking);
begin
  FComportHwHandshaking := Value;
  if Connected then
    ApplyComPortSettings;
end;

procedure TComportDriverThread.SetComportInputBufferSize(Value: Word);
begin
  FreeMem(FTempInputBuffer,FComportInputBufferSize);
  FComportInputBufferSize := Value;
  GetMem(FTempInputBuffer,FComportInputBufferSize);
  if Connected then
    ApplyComPortSettings;
end;

procedure TComportDriverThread.SetComportNumber(Value: TComPortNumber);
begin
  if Connected then
    exit;
  FComportNumber := Value;
end;

procedure TComportDriverThread.SetComportOutputBufferSize(Value: Word);
begin
  FComportOutputBufferSize := Value;
  if Connected then
    ApplyComPortSettings;
end;

procedure TComportDriverThread.SetComportParity(Value: TComPortParity);
begin
  FComportParity := Value;
  if Connected then
    ApplyComPortSettings;
end;

procedure TComportDriverThread.SetComportPollingDelay(Value: Word);
begin
  FComportPollingDelay := Value;
end;

procedure TComportDriverThread.SetComportStopBits(Value: TComPortStopBits);
begin
  FComportStopBits := Value;
  if Connected then
    ApplyComPortSettings;
end;

procedure TComportDriverThread.SetComportSwHandshaking(Value: TComPortSwHandshaking);
begin
  FComportSwHandshaking := Value;
  if Connected then
    ApplyComPortSettings;
end;

procedure TComportDriverThread.DoDataReceived;
begin
  if Assigned(FOnReceiveData) then
    FOnReceiveData(Self);
end;

procedure TComportDriverThread.SetComPortActive(Value: Boolean);
var
  DumpString : string;
begin
  FComPortActive := Value;
  if csDesigning in ComponentState then
    Exit;
  if FComPortActive then
  begin
    //Just dump the contents of the input buffer of the com-port.
    ReadString(DumpString);
    FTimer.Enabled := True;
  end
  else
    FTimer.Enabled := False;
  FTimer.SupRes;
end;

{ TTimerThread }

procedure TTimerThread.Execute;
begin
  Priority := tpNormal;
  repeat
    Sleep(500);
    if Assigned(FOnTimer) then
      Synchronize(FOnTimer);
  until
    Terminated;
end;

procedure TTimerThread.SupRes;
begin
  if not Suspended then
    Suspend;
  if FEnabled then
    Resume;
end; 

end.

Проект Delphi World © Выпуск 2002 - 2004
Автор проекта: ___Nikolay