controls/comport/KOLMHComPort.pas

   1 unit KOLMHComPort;
   2 //  MHComPort Êîìïîíåíò (MHComPort Component)
   3 //  Àâòîð (Author): Æàðîâ Äìèòðèé (Zharov Dmitry) aka Ãýíäàëüô (Gandalf)
   4 //  Äàòà ñîçäàíèÿ (Create date): 4-ìàé(may)-2002
   5 //  Äàòà êîððåêöèè (Last correction Date): 15-ôåâ(feb)-2003
   6 //  Âåðñèÿ (Version): 1.12
   7 //  EMail: Gandalf@kol.mastak.ru
   8 //  WWW: http://kol.mastak.ru
   9 //  Áëàãîäàðíîñòè (Thanks):
  10 //    Dejan Crnila
  11 //    Alexander Pravdin
  12 //  Íîâîå â (New in):
  13 //  V1.12
  14 //  [+] Ïîääåðæêà D7 (D7 Support) [KOLnMCK]
  15 //
  16 //  V1.11
  17 //  [+] Ïîääåðæêà D6 (D6 Support) <Thanks to Alexander Pravdin> [KOLnMCK]
  18 //
  19 //  V1.1
  20 //  [!] Ñîîáùåíèÿ (Events) [KOLnMCK]
  21 //  [+] Ïðèâÿçêà ñîáûòèé (Assign Events) [MCK]
  22 //
  23 //  Ñïèñîê äåë (To-Do list):
  24 //  1. Àññåìáëåð (Asm)
  25 //  2. Îïòèìèçèðîâàòü (Optimize)
  26 //  3. Ïîä÷èñòèòü (Clear Stuff)
  27 //  4. Îøèáêè (Errors)
  28 //  5. Óäàëèòü RxOnBuf (Strip RxOnBuf)
  29 //  6. Íîðìàëüíàÿ èêîíêà (Icon Correct)
  30
  31 interface
  32
  33 uses
  34  KOL, Windows, Messages;
  35
  36 type
  37
  38   TPort = string;
  39   TBaudRate = (brCustom, br110, br300, br600, br1200, br2400, br4800, br9600, br14400,
  40     br19200, br38400, br56000, br57600, br115200, br128000, br256000);
  41   TStopBits = (sbOneStopBit, sbOne5StopBits, sbTwoStopBits);
  42   TDataBits = (dbFive, dbSix, dbSeven, dbEight);
  43   TParityBits = (prNone, prOdd, prEven, prMark, prSpace);
  44   TDTRFlowControl = (dtrDisable, dtrEnable, dtrHandshake);
  45   TRTSFlowControl = (rtsDisable, rtsEnable, rtsHandshake, rtsToggle);
  46   TFlowControl = (fcHardware, fcSoftware, fcNone, fcCustom);
  47   TComEvent = (evRxChar, evTxEmpty, evRxFlag, evRing, evBreak, evCTS, evDSR,
  48     evError, evRLSD, evRx80Full);
  49   TComEvents = set of TComEvent;
  50   TComSignal = (csCTS, csDSR, csRing, csRLSD);
  51   TComSignals = set of TComSignal;
  52   TComLedSignal = (lsCTS, lsDSR, lsRLSD, lsRing, lsRx, lsTx);
  53   TComError = (ceFrame, ceRxParity, ceOverrun, ceBreak, ceIO, ceMode, ceRxOver,
  54     ceTxFull);
  55   TComErrors = set of TComError;
  56   TSyncMethod = (smThreadSync, smWindowSync, smNone);
  57   TStoreType = (stRegistry, stIniFile);
  58   TStoredProp = (spBasic, spFlowControl, spBuffer, spTimeouts, spParity,
  59     spOthers);
  60   TStoredProps = set of TStoredProp;
  61   TRxCharEvent = procedure(Sender: PObj; Count: Integer) of object;
  62   TRxBufEvent = procedure(Sender: PObj; Buf:array of Byte;
  63     Count: Integer) of object;
  64   TRxStrEvent = procedure(Sender: PObj; Str: string) of object;
  65   TComErrorEvent = procedure(Sender: PObj; Errors: TComErrors) of object;
  66   TComSignalEvent = procedure(Sender: PObj; OnOff: Boolean) of object;
  67
  68   // types for asynchronous calls
  69   TOperationKind = (okWrite, okRead);
  70   TAsync = record
  71     Overlapped: TOverlapped;
  72     Kind: TOperationKind;
  73   end;
  74   PAsync = ^TAsync;
  75
  76   // TComPort component and asistant classes
  77
  78
  79   PMHComPort =^TMHComPort;
  80   TKOLMHComPort = PMHComPort;
  81
  82   PMHComBuffer=^TMHComBuffer;
  83   TKOLMHComBuffer=PMHComBuffer;
  84
  85   PMHComParity=^TMHComParity;
  86   TKOLMHComParity=PMHComParity;
  87
  88   PMHComFlowControl=^TMHComFlowControl;
  89   TKOLMHComFlowControl=PMHComFlowControl;
  90
  91   PMHComTimeouts=^TMHComTimeouts;
  92   TKOLMHComTimeouts=PMHComTimeouts;
  93
  94   PMHComThread=^TMHComThread;
  95   TKOLMHComThread=PMHComThread;
  96
  97   TMHComThread = object(TObj)
  98   private
  99     FComPort: PMHComPort;
 100     FStopEvent: THandle;
 101     FEvents: TComEvents;
 102     FThread:PThread;
 103   protected
 104     procedure DispatchComMsg;
 105     procedure DoEvents;
 106     procedure SendEvents;
 107     procedure Stop;
 108   public
 109     function Execute(Sender:PThread): integer; virtual;
 110     destructor Destroy; virtual;
 111   end;
 112
 113   TMHComTimeouts = object(TObj)
 114   private
 115     FComPort: PMHComPort;
 116     FReadInterval: Integer;
 117     FReadTotalM: Integer;
 118     FReadTotalC: Integer;
 119     FWriteTotalM: Integer;
 120     FWriteTotalC: Integer;
 121     procedure SetComPort(const AComPort: PMHComPort);
 122     procedure SetReadInterval(const Value: Integer);
 123     procedure SetReadTotalM(const Value: Integer);
 124     procedure SetReadTotalC(const Value: Integer);
 125     procedure SetWriteTotalM(const Value: Integer);
 126     procedure SetWriteTotalC(const Value: Integer);
 127   protected
 128     procedure AssignTo(Dest: PObj);
 129   public
 130     property ComPort: PMHComPort read FComPort;
 131     property ReadInterval: Integer read FReadInterval write SetReadInterval default -1;
 132     property ReadTotalMultiplier: Integer read FReadTotalM write SetReadTotalM default 0;
 133     property ReadTotalConstant: Integer read FReadTotalC write SetReadTotalC default 0;
 134     property WriteTotalMultiplier: Integer
 135       read FWriteTotalM write SetWriteTotalM default 100;
 136     property WriteTotalConstant: Integer
 137       read FWriteTotalC write SetWriteTotalC default 1000;
 138   end;
 139
 140   TMHComFlowControl = object(TObj)
 141   private
 142     FComPort: PMHComPort;
 143     FOutCTSFlow: Boolean;
 144     FOutDSRFlow: Boolean;
 145     FControlDTR: TDTRFlowControl;
 146     FControlRTS: TRTSFlowControl;
 147     FXonXoffOut: Boolean;
 148     FXonXoffIn:  Boolean;
 149     FDSRSensitivity: Boolean;
 150     FTxContinueOnXoff: Boolean;
 151     FXonChar: Char;
 152     FXoffChar: Char;
 153     procedure SetComPort(const AComPort: PMHComPort);
 154     procedure SetOutCTSFlow(const Value: Boolean);
 155     procedure SetOutDSRFlow(const Value: Boolean);
 156     procedure SetControlDTR(const Value: TDTRFlowControl);
 157     procedure SetControlRTS(const Value: TRTSFlowControl);
 158     procedure SetXonXoffOut(const Value: Boolean);
 159     procedure SetXonXoffIn(const Value: Boolean);
 160     procedure SetDSRSensitivity(const Value: Boolean);
 161     procedure SetTxContinueOnXoff(const Value: Boolean);
 162     procedure SetXonChar(const Value: Char);
 163     procedure SetXoffChar(const Value: Char);
 164     procedure SetFlowControl(const Value: TFlowControl);
 165     function GetFlowControl: TFlowControl;
 166   protected
 167     procedure AssignTo(Dest: PObj);
 168   public
 169     property ComPort: PMHComPort read FComPort;
 170     property FlowControl: TFlowControl read GetFlowControl write SetFlowControl stored False;
 171     property OutCTSFlow: Boolean read FOutCTSFlow write SetOutCTSFlow;
 172     property OutDSRFlow: Boolean read FOutDSRFlow write SetOutDSRFlow;
 173     property ControlDTR: TDTRFlowControl read FControlDTR write SetControlDTR;
 174     property ControlRTS: TRTSFlowControl read FControlRTS write SetControlRTS;
 175     property XonXoffOut: Boolean read FXonXoffOut write SetXonXoffOut;
 176     property XonXoffIn:  Boolean read FXonXoffIn write SetXonXoffIn;
 177     property DSRSensitivity: Boolean
 178       read FDSRSensitivity write SetDSRSensitivity default False;
 179     property TxContinueOnXoff: Boolean
 180       read FTxContinueOnXoff write SetTxContinueOnXoff default False;
 181     property XonChar: Char read FXonChar write SetXonChar default #17;
 182     property XoffChar: Char read FXoffChar write SetXoffChar default #19;
 183   end;
 184
 185   TMHComParity = object(TObj)
 186   private
 187     FComPort: PMHComPort;
 188     FBits: TParityBits;
 189     FCheck: Boolean;
 190     FReplace: Boolean;
 191     FReplaceChar: Char;
 192     procedure SetComPort(const AComPort: PMHComPort);
 193     procedure SetBits(const Value: TParityBits);
 194     procedure SetCheck(const Value: Boolean);
 195     procedure SetReplace(const Value: Boolean);
 196     procedure SetReplaceChar(const Value: Char);
 197   protected
 198     procedure AssignTo(Dest: PObj);
 199   public
 200     property ComPort: PMHComPort read FComPort;
 201     property Bits: TParityBits read FBits write SetBits;
 202     property Check: Boolean read FCheck write SetCheck default False;
 203     property Replace: Boolean read FReplace write SetReplace default False;
 204     property ReplaceChar: Char read FReplaceChar write SetReplaceChar default #0;
 205   end;
 206
 207   TMHComBuffer = object(TObj)
 208   private
 209     FComPort: PMHComPort;
 210     FInputSize: Integer;
 211     FOutputSize: Integer;
 212     procedure SetComPort(const AComPort: PMHComPort);
 213     procedure SetInputSize(const Value: Integer);
 214     procedure SetOutputSize(const Value: Integer);
 215   protected
 216     procedure AssignTo(Dest: PObj);// override;
 217   public
 218     property ComPort: PMHComPort read FComPort;
 219     property InputSize: Integer read FInputSize write SetInputSize default 1024;
 220     property OutputSize: Integer read FOutputSize write SetOutputSize default 1024;
 221   end;
 222
 223   TMHComPort = object(TObj)
 224   private
 225     FEventThread: PMHComThread;
 226     FThreadCreated: Boolean;
 227     FHandle: THandle;
 228     FWindow: THandle;
 229     FUpdateCount: Integer;
 230     FConnected: Boolean;
 231     FBaudRate: TBaudRate;
 232     FCustomBaudRate: Integer;
 233     FPort: TPort;
 234     FStopBits: TStopBits;
 235     FDataBits: TDataBits;
 236     FDiscardNull: Boolean;
 237     FEventChar: Char;
 238     FEvents: TComEvents;
 239     FBuffer: PMHComBuffer;
 240     FParity: PMHComParity;
 241     FTimeouts: PMHComTimeouts;
 242     FFlowControl: PMHComFlowControl;
 243     FSyncMethod: TSyncMethod;
 244     FStoredProps: TStoredProps;
 245     FOnRxChar: TRxCharEvent;
 246     FOnRxBuf: TRxBufEvent;
 247     FOnTxEmpty: TOnEvent;
 248     FOnBreak: TOnEvent;
 249     FOnRing: TOnEvent;
 250     FOnCTSChange: TComSignalEvent;
 251     FOnDSRChange: TComSignalEvent;
 252     FOnRLSDChange: TComSignalEvent;
 253     FOnError: TComErrorEvent;
 254     FOnRxFlag: TOnEvent;
 255     FOnAfterOpen: TOnEvent;
 256     FOnAfterClose: TOnEvent;
 257     FOnBeforeOpen: TOnEvent;
 258     FOnBeforeClose: TOnEvent;
 259     FOnRx80Full: TOnEvent;
 260     function GetTriggersOnRxChar: Boolean;
 261     procedure SetConnected(const Value: Boolean);
 262     procedure SetBaudRate(const Value: TBaudRate);
 263     procedure SetCustomBaudRate(const Value: Integer);
 264     procedure SetPort(const Value: TPort);
 265     procedure SetStopBits(const Value: TStopBits);
 266     procedure SetDataBits(const Value: TDataBits);
 267     procedure SetDiscardNull(const Value: Boolean);
 268     procedure SetEventChar(const Value: Char);
 269     procedure SetSyncMethod(const Value: TSyncMethod);
 270     procedure SetParity(const Value: PMHComParity);
 271     procedure SetTimeouts(const Value: PMHComTimeouts);
 272     procedure SetBuffer(const Value: PMHComBuffer);
 273     procedure SetFlowControl(const Value: PMHComFlowControl);
 274     procedure CheckSignals(Open2: Boolean);
 275     procedure WindowMethod(var Message: TMessage);
 276     procedure CallAfterOpen;
 277     procedure CallAfterClose;
 278     procedure CallBeforeOpen;
 279     procedure CallBeforeClose;
 280     procedure CallRxChar;
 281     procedure CallTxEmpty;
 282     procedure CallBreak;
 283     procedure CallRing;
 284     procedure CallRxFlag;
 285     procedure CallCTSChange;
 286     procedure CallDSRChange;
 287     procedure CallError;
 288     procedure CallRLSDChange;
 289     procedure CallRx80Full;
 290   protected
 291     procedure Loaded;
 292     procedure DoAfterClose;
 293     procedure DoAfterOpen;
 294     procedure DoBeforeClose;
 295     procedure DoBeforeOpen;
 296     procedure DoRxChar(Count: Integer);
 297     procedure DoRxBuf(Buf:array of Byte; Count: Integer);
 298     procedure DoTxEmpty;
 299     procedure DoBreak;
 300     procedure DoRing;
 301     procedure DoRxFlag;
 302     procedure DoCTSChange(OnOff: Boolean);
 303     procedure DoDSRChange(OnOff: Boolean);
 304     procedure DoError(Errors: TComErrors);
 305     procedure DoRLSDChange(OnOff: Boolean);
 306     procedure DoRx80Full;
 307     procedure CreateHandle; virtual;
 308     procedure DestroyHandle; virtual;
 309     procedure ApplyDCB;
 310     procedure ApplyTimeouts;
 311     procedure ApplyBuffer;
 312     procedure SetupComPort; virtual;
 313   public
 314     destructor Destroy; virtual;
 315     procedure BeginUpdate;
 316     procedure EndUpdate;
 317     procedure Open;
 318     procedure Close;
 319     function InputCount: Integer;
 320     function OutputCount: Integer;
 321     function Signals: TComSignals;
 322     function StateFlags: TComStateFlags;
 323     procedure SetDTR(OnOff: Boolean);
 324     procedure SetRTS(OnOff: Boolean);
 325     procedure SetXonXoff(OnOff: Boolean);
 326     procedure SetBreak(OnOff: Boolean);
 327     procedure ClearBuffer(Input, Output: Boolean);
 328 //    function LastErrors: TComErrors;
 329     function Write(const Buf; Count: Integer): Integer;
 330     function WriteStr(Str: string): Integer;
 331     function Read(var Buf; Count: Integer): Integer;
 332     function ReadStr(var Str: string; Count: Integer): Integer;
 333     function WriteAsync(const Buf; Count: Integer;
 334       var AsyncPtr: PAsync): Integer;
 335     function WriteStrAsync(Str: string; var AsyncPtr: PAsync): Integer;
 336     function ReadAsync(var Buf; Count: Integer;
 337       var AsyncPtr: PAsync): Integer;
 338     function ReadStrAsync(var Str: string; Count: Integer;
 339       var AsyncPtr: PAsync): Integer;
 340     function WaitForAsync(var AsyncPtr: PAsync): Integer;
 341     function IsAsyncCompleted(AsyncPtr: PAsync): Boolean;
 342     procedure WaitForEvent(var Events2: TComEvents; Timeout: Integer);
 343     procedure AbortAllAsync;
 344     procedure TransmitChar(Ch: Char);
 345 //    procedure RegisterLink(AComLink: PMHComLink);
 346 //    procedure UnRegisterLink(AComLink: PMHComLink);
 347     property Handle: THandle read FHandle;
 348     property TriggersOnRxChar: Boolean read GetTriggersOnRxChar;
 349     property StoredProps: TStoredProps read FStoredProps write FStoredProps;
 350     property Connected: Boolean read FConnected write SetConnected default False;
 351     property BaudRate: TBaudRate read FBaudRate write SetBaudRate;
 352     property CustomBaudRate: Integer
 353       read FCustomBaudRate write SetCustomBaudRate;
 354     property Port: TPort read FPort write SetPort;
 355     property Parity: PMHComParity read FParity write SetParity;
 356     property StopBits: TStopBits read FStopBits write SetStopBits;
 357     property DataBits: TDataBits read FDataBits write SetDataBits;
 358     property DiscardNull: Boolean read FDiscardNull write SetDiscardNull default False;
 359     property EventChar: Char read FEventChar write SetEventChar default #0;
 360     property Events: TComEvents read FEvents write FEvents;
 361     property Buffer: PMHComBuffer read FBuffer write SetBuffer;
 362     property FlowControl: PMHComFlowControl read FFlowControl write SetFlowControl;
 363     property Timeouts: PMHComTimeouts read FTimeouts write SetTimeouts;
 364     property SyncMethod: TSyncMethod read FSyncMethod write SetSyncMethod default smThreadSync;
 365     property OnAfterOpen: TOnEvent read FOnAfterOpen write FOnAfterOpen;
 366     property OnAfterClose: TOnEvent read FOnAfterClose write FOnAfterClose;
 367     property OnBeforeOpen: TOnEvent read FOnBeforeOpen write FOnBeforeOpen;
 368     property OnBeforeClose: TOnEvent read FOnBeforeClose write FOnBeforeClose;
 369     property OnRxChar: TRxCharEvent read FOnRxChar write FOnRxChar;
 370     property OnRxBuf: TRxBufEvent read FOnRxBuf write FOnRxBuf;
 371     property OnTxEmpty: TOnEvent read FOnTxEmpty write FOnTxEmpty;
 372     property OnBreak: TOnEvent read FOnBreak write FOnBreak;
 373     property OnRing: TOnEvent read FOnRing write FOnRing;
 374     property OnCTSChange: TComSignalEvent read FOnCTSChange write FOnCTSChange;
 375     property OnDSRChange: TComSignalEvent read FOnDSRChange write FOnDSRChange;
 376     property OnRLSDChange: TComSignalEvent read FOnRLSDChange write FOnRLSDChange;
 377     property OnRxFlag: TOnEvent read FOnRxFlag write FOnRxFlag;
 378     property OnError: TComErrorEvent read FOnError write FOnError;
 379     property OnRx80Full: TOnEvent read FOnRx80Full write FOnRx80Full;
 380   end;
 381
 382 const
 383   // error messages
 384   ComErrorMessages: array[1..21] of string =
 385     ('Unable to open com port',
 386      'WriteFile function failed',
 387      'ReadFile function failed',
 388      'Invalid Async parameter',
 389      'PurgeComm function failed',
 390      'Unable to get async status',
 391      'SetCommState function failed',
 392      'SetCommTimeouts failed',
 393      'SetupComm function failed',
 394      'ClearCommError function failed',
 395      'GetCommModemStatus function failed',
 396      'EscapeCommFunction function failed',
 397      'TransmitCommChar function failed',
 398      'Cannot set SyncMethod while connected',
 399      'EnumPorts function failed',
 400      'Failed to store settings',
 401      'Failed to load settings',
 402      'Link (un)registration failed',
 403      'Cannot change led state if ComPort is selected',
 404      'Cannot wait for event if event thread is created',
 405      'WaitForEvent method failed');
 406
 407   // auxilary constants used not defined in windows.pas
 408   dcb_Binary           = $00000001;
 409   dcb_Parity           = $00000002;
 410   dcb_OutxCTSFlow      = $00000004;
 411   dcb_OutxDSRFlow      = $00000008;
 412   dcb_DTRControl       = $00000030;
 413   dcb_DSRSensivity     = $00000040;
 414   dcb_TxContinueOnXoff = $00000080;
 415   dcb_OutX             = $00000100;
 416   dcb_InX              = $00000200;
 417   dcb_ErrorChar        = $00000400;
 418   dcb_Null             = $00000800;
 419   dcb_RTSControl       = $00003000;
 420   dcb_AbortOnError     = $00004000;
 421
 422   // com port window message
 423   CM_COMPORT           = WM_USER + 1;
 424
 425 function NewMHComThread(AComPort: PMHComPort):PMHComThread;
 426 function NewMHComTimeouts:PMHComTimeouts;
 427 function NewMHComFlowControl:PMHComFlowControl;
 428 function NewMHComParity:PMHComParity;
 429 function NewMHComBuffer:PMHComBuffer;
 430 function NewMHComPort( Wnd: PControl):PMHComPort;
 431
 432 implementation
 433
 434 {function WndProcMHFontDialog( Control: PControl; var Msg: TMsg; var Rslt: Integer ) : Boolean;
 435 begin
 436   Result:=False;
 437   if Msg.message=HelpMessageIndex then
 438   begin
 439     if Assigned( MHFontDialogNow.FOnHelp ) then
 440       MHFontDialogNow.FOnHelp( @MHFontDialogNow);
 441     Rslt:=0;
 442     Result:=True;
 443   end;
 444 end;
 445  }
 446
 447 function EventsToInt(const Events: TComEvents): Integer;
 448 begin
 449   Result := 0;
 450   if evRxChar in Events then
 451     Result := Result or EV_RXCHAR;
 452   if evRxFlag in Events then
 453     Result := Result or EV_RXFLAG;
 454   if evTxEmpty in Events then
 455     Result := Result or EV_TXEMPTY;
 456   if evRing in Events then
 457     Result := Result or EV_RING;
 458   if evCTS in Events then
 459     Result := Result or EV_CTS;
 460   if evDSR in Events then
 461     Result := Result or EV_DSR;
 462   if evRLSD in Events then
 463     Result := Result or EV_RLSD;
 464   if evError in Events then
 465     Result := Result or EV_ERR;
 466   if evBreak in Events then
 467     Result := Result or EV_BREAK;
 468   if evRx80Full in Events then
 469     Result := Result or EV_RX80FULL;
 470 end;
 471
 472 function IntToEvents(Mask: Integer): TComEvents;
 473 begin
 474   Result := [];
 475   if (EV_RXCHAR and Mask) <> 0 then
 476     Result := Result + [evRxChar];
 477   if (EV_TXEMPTY and Mask) <> 0 then
 478     Result := Result + [evTxEmpty];
 479   if (EV_BREAK and Mask) <> 0 then
 480     Result := Result + [evBreak];
 481   if (EV_RING and Mask) <> 0 then
 482     Result := Result + [evRing];
 483   if (EV_CTS and Mask) <> 0 then
 484     Result := Result + [evCTS];
 485   if (EV_DSR and Mask) <> 0 then
 486     Result := Result + [evDSR];
 487   if (EV_RXFLAG and Mask) <> 0 then
 488     Result := Result + [evRxFlag];
 489   if (EV_RLSD and Mask) <> 0 then
 490     Result := Result + [evRLSD];
 491   if (EV_ERR and Mask) <> 0 then
 492     Result := Result + [evError];
 493   if (EV_RX80FULL and Mask) <> 0 then
 494     Result := Result + [evRx80Full];
 495 end;
 496
 497
 498 procedure InitAsync(var AsyncPtr: PAsync);
 499 begin
 500   New(AsyncPtr);
 501   with AsyncPtr^ do
 502   begin
 503     FillChar(Overlapped, SizeOf(TOverlapped), 0);
 504     Overlapped.hEvent := CreateEvent(nil, True, True, nil);
 505   end;
 506 end;
 507
 508 procedure DoneAsync(var AsyncPtr: PAsync);
 509 begin
 510   with AsyncPtr^ do
 511     CloseHandle(Overlapped.hEvent);
 512   Dispose(AsyncPtr);
 513   AsyncPtr := nil;
 514 end;
 515
 516 function NewMHComThread(AComPort: PMHComPort):PMHComThread;
 517 begin
 518   New(Result, Create);
 519   Result.FStopEvent := CreateEvent(nil, True, False, nil);
 520   Result.FComPort := AComPort;
 521   Result.FThread:=NewThreadEx(Result.Execute);
 522   // select which events are monitored
 523   SetCommMask(Result.FComPort.Handle, EventsToInt(Result.FComPort.Events));
 524   // execute thread
 525 //  Result.Resume;
 526 end;
 527
 528
 529 // destroy thread
 530 destructor TMHComThread.Destroy;
 531 begin
 532   Stop;
 533   FThread.Resume;
 534   FThread.WaitFor;
 535   FThread.Free;
 536   inherited;
 537 end;
 538
 539 {function MHComThreadExecute(Sender:PMHComThread):Integer;
 540 var
 541   EventHandles: array[0..1] of THandle;
 542   Overlapped: TOverlapped;
 543   Signaled, BytesTrans, Mask: DWORD;
 544 begin
 545   FillChar(Overlapped, SizeOf(Overlapped), 0);
 546   Overlapped.hEvent := CreateEvent(nil, True, True, nil);
 547   EventHandles[0] := PMHComThread(Sender).FStopEvent;
 548   EventHandles[1] := Overlapped.hEvent;
 549   repeat
 550     // wait for event to occur on serial port
 551     WaitCommEvent(PMHComThread(Sender).FComPort.Handle, Mask, @Overlapped);
 552     Signaled := WaitForMultipleObjects(2, @EventHandles, False, INFINITE);
 553     // if event occurs, dispatch it
 554     if (Signaled = WAIT_OBJECT_0 + 1)
 555       and GetOverlappedResult(PMHComThread(Sender).FComPort.Handle, Overlapped, BytesTrans, False)
 556     then
 557     begin
 558       PMHComThread(Sender).FEvents := IntToEvents(Mask);
 559       PMHComThread(Sender).DispatchComMsg;
 560     end;
 561   until Signaled <> (WAIT_OBJECT_0 + 1);
 562   // clear buffers
 563   SetCommMask(PMHComThread(Sender).FComPort.Handle, 0);
 564   PurgeComm(PMHComThread(Sender).FComPort.Handle, PURGE_TXCLEAR or PURGE_RXCLEAR);
 565   CloseHandle(Overlapped.hEvent);
 566   CloseHandle(PMHComThread(Sender).FStopEvent);
 567 end;
 568  }
 569 // thread action
 570 function TMHComThread.Execute(Sender:PThread):Integer;
 571 var
 572   EventHandles: array[0..1] of THandle;
 573   Overlapped: TOverlapped;
 574   Signaled, BytesTrans, Mask: DWORD;
 575 begin
 576   FillChar(Overlapped, SizeOf(Overlapped), 0);
 577   Overlapped.hEvent := CreateEvent(nil, True, True, nil);
 578   EventHandles[0] := FStopEvent;
 579   EventHandles[1] := Overlapped.hEvent;
 580   repeat
 581     // wait for event to occur on serial port
 582     WaitCommEvent(FComPort.Handle, Mask, @Overlapped);
 583     Signaled := WaitForMultipleObjects(2, @EventHandles, False, INFINITE);
 584     // if event occurs, dispatch it
 585     if (Signaled = WAIT_OBJECT_0 + 1)
 586       and GetOverlappedResult(FComPort.Handle, Overlapped, BytesTrans, False)
 587     then
 588     begin
 589       FEvents := IntToEvents(Mask);
 590       DispatchComMsg;
 591     end;
 592   until Signaled <> (WAIT_OBJECT_0 + 1);
 593   // clear buffers
 594   SetCommMask(FComPort.Handle, 0);
 595   PurgeComm(FComPort.Handle, PURGE_TXCLEAR or PURGE_RXCLEAR);
 596   CloseHandle(Overlapped.hEvent);
 597   CloseHandle(FStopEvent);
 598 end;
 599
 600 // stop thread
 601 procedure TMHComThread.Stop;
 602 begin
 603   SetEvent(FStopEvent);
 604   Sleep(0);
 605 end;
 606
 607 // dispatch events
 608 procedure TMHComThread.DispatchComMsg;
 609 begin
 610
 611   case FComPort.SyncMethod of
 612     smThreadSync:{ Synchronize}(DoEvents); // call events in main thread
 613     smWindowSync: SendEvents; // call events in thread that opened the port
 614     smNone:       DoEvents; // call events inside monitoring thread
 615   end;
 616
 617 end;
 618
 619 // send events to TCustomComPort component using window message
 620 procedure TMHComThread.SendEvents;
 621 begin
 622   if evRxChar in FEvents then
 623     SendMessage(FComPort.FWindow, CM_COMPORT, EV_RXCHAR, 0);
 624   if evTxEmpty in FEvents then
 625     SendMessage(FComPort.FWindow, CM_COMPORT, EV_TXEMPTY, 0);
 626   if evBreak in FEvents then
 627     SendMessage(FComPort.FWindow, CM_COMPORT, EV_BREAK, 0);
 628   if evRing in FEvents then
 629     SendMessage(FComPort.FWindow, CM_COMPORT, EV_RING, 0);
 630   if evCTS in FEvents then
 631     SendMessage(FComPort.FWindow, CM_COMPORT, EV_CTS, 0);
 632   if evDSR in FEvents then
 633     SendMessage(FComPort.FWindow, CM_COMPORT, EV_DSR, 0);
 634   if evRxFlag in FEvents then
 635     SendMessage(FComPort.FWindow, CM_COMPORT, EV_RXFLAG, 0);
 636   if evRing in FEvents then
 637     SendMessage(FComPort.FWindow, CM_COMPORT, EV_RLSD, 0);
 638   if evError in FEvents then
 639     SendMessage(FComPort.FWindow, CM_COMPORT, EV_ERR, 0);
 640   if evRx80Full in FEvents then
 641     SendMessage(FComPort.FWindow, CM_COMPORT, EV_RX80FULL, 0);
 642 end;
 643
 644 // call events
 645 procedure TMHComThread.DoEvents;
 646 begin
 647   if evRxChar in FEvents then
 648     FComPort.CallRxChar;
 649   if evTxEmpty in FEvents then
 650     FComPort.CallTxEmpty;
 651   if evBreak in FEvents then
 652     FComPort.CallBreak;
 653   if evRing in FEvents then
 654     FComPort.CallRing;
 655   if evCTS in FEvents then
 656     FComPort.CallCTSChange;
 657   if evDSR in FEvents then
 658     FComPort.CallDSRChange;
 659   if evRxFlag in FEvents then
 660     FComPort.CallRxFlag;
 661   if evRLSD in FEvents then
 662     FComPort.CallRLSDChange;
 663   if evError in FEvents then
 664     FComPort.CallError;
 665   if evRx80Full in FEvents then
 666     FComPort.CallRx80Full;
 667 end;
 668
 669
 670 function NewMHComTimeouts:PMHComTimeouts;
 671 begin
 672   New(Result, Create);
 673   Result.FReadInterval := -1;
 674   Result.FWriteTotalM := 100;
 675   Result.FWriteTotalC := 1000;
 676 end;
 677
 678 // copy properties to other class
 679 procedure TMHComTimeouts.AssignTo(Dest: PObj);
 680 begin
 681   if TMHComTimeouts.AncestorOfObject(Dest) then
 682   begin
 683     with PMHComTimeouts(Dest)^ do
 684     begin
 685       FReadInterval := Self.ReadInterval;
 686       FReadTotalM   := Self.ReadTotalMultiplier;
 687       FReadTotalC   := Self.ReadTotalConstant;
 688       FWriteTotalM  := Self.WriteTotalMultiplier;
 689       FWriteTotalC  := Self.WriteTotalConstant;
 690     end
 691   end
 692   else
 693     inherited;
 694 end;
 695
 696 // select TCustomComPort to own this class
 697 procedure TMHComTimeouts.SetComPort(const AComPort: PMHComPort);
 698 begin
 699   FComPort := AComPort;
 700 end;
 701
 702 // set read interval
 703 procedure TMHComTimeouts.SetReadInterval(const Value: Integer);
 704 begin
 705   if Value <> FReadInterval then
 706   begin
 707     FReadInterval := Value;
 708     // if possible, apply the changes
 709     if FComPort <> nil then
 710       FComPort.ApplyTimeouts;
 711   end;
 712 end;
 713
 714 // set read total constant
 715 procedure TMHComTimeouts.SetReadTotalC(const Value: Integer);
 716 begin
 717   if Value <> FReadTotalC then
 718   begin
 719     FReadTotalC := Value;
 720     if FComPort <> nil then
 721       FComPort.ApplyTimeouts;
 722   end;
 723 end;
 724
 725 // set read total multiplier
 726 procedure TMHComTimeouts.SetReadTotalM(const Value: Integer);
 727 begin
 728   if Value <> FReadTotalM then
 729   begin
 730     FReadTotalM := Value;
 731     if FComPort <> nil then
 732       FComPort.ApplyTimeouts;
 733   end;
 734 end;
 735
 736 // set write total constant
 737 procedure TMHComTimeouts.SetWriteTotalC(const Value: Integer);
 738 begin
 739   if Value <> FWriteTotalC then
 740   begin
 741     FWriteTotalC := Value;
 742     if FComPort <> nil then
 743       FComPort.ApplyTimeouts;
 744   end;
 745 end;
 746
 747 // set write total multiplier
 748 procedure TMHComTimeouts.SetWriteTotalM(const Value: Integer);
 749 begin
 750   if Value <> FWriteTotalM then
 751   begin
 752     FWriteTotalM := Value;
 753     if FComPort <> nil then
 754       FComPort.ApplyTimeouts;
 755   end;
 756 end;
 757
 758
 759 function NewMHComFlowControl:PMHComFlowControl;
 760 begin
 761   New(Result, Create);
 762   Result.FXonChar := #17;
 763   Result.FXoffChar := #19;
 764 end;
 765
 766
 767
 768 // copy properties to other class
 769 procedure TMHComFlowControl.AssignTo(Dest: PObj);
 770 begin
 771   if TMHComFlowControl.AncestorOfObject(Dest) then
 772   begin
 773     with PMHComFlowControl(Dest)^ do
 774     begin
 775       FOutCTSFlow       := Self.OutCTSFlow;
 776       FOutDSRFlow       := Self.OutDSRFlow;
 777       FControlDTR       := Self.ControlDTR;
 778       FControlRTS       := Self.ControlRTS;
 779       FXonXoffOut       := Self.XonXoffOut;
 780       FXonXoffIn        := Self.XonXoffIn;
 781       FTxContinueOnXoff := Self.TxContinueOnXoff;
 782       FDSRSensitivity   := Self.DSRSensitivity;
 783       FXonChar          := Self.XonChar;
 784       FXoffChar         := Self.XoffChar;
 785     end
 786   end
 787   else
 788     inherited;
 789 end;
 790
 791 // select TCustomComPort to own this class
 792 procedure TMHComFlowControl.SetComPort(const AComPort: PMHComPort);
 793 begin
 794   FComPort := AComPort;
 795 end;
 796
 797 // set input flow control for DTR (data-terminal-ready)
 798 procedure TMHComFlowControl.SetControlDTR(const Value: TDTRFlowControl);
 799 begin
 800   if Value <> FControlDTR then
 801   begin
 802     FControlDTR := Value;
 803     if FComPort <> nil then
 804       FComPort.ApplyDCB;
 805   end;
 806 end;
 807
 808 // set input flow control for RTS (request-to-send)
 809 procedure TMHComFlowControl.SetControlRTS(const Value: TRTSFlowControl);
 810 begin
 811   if Value <> FControlRTS then
 812   begin
 813     FControlRTS := Value;
 814     if FComPort <> nil then
 815       FComPort.ApplyDCB;
 816   end;
 817 end;
 818
 819 // set ouput flow control for CTS (clear-to-send)
 820 procedure TMHComFlowControl.SetOutCTSFlow(const Value: Boolean);
 821 begin
 822   if Value <> FOutCTSFlow then
 823   begin
 824     FOutCTSFlow := Value;
 825     if FComPort <> nil then
 826       FComPort.ApplyDCB;
 827   end;
 828 end;
 829
 830 // set output flow control for DSR (data-set-ready)
 831 procedure TMHComFlowControl.SetOutDSRFlow(const Value: Boolean);
 832 begin
 833   if Value <> FOutDSRFlow then
 834   begin
 835     FOutDSRFlow := Value;
 836     if FComPort <> nil then
 837       FComPort.ApplyDCB;
 838   end;
 839 end;
 840
 841 // set software input flow control
 842 procedure TMHComFlowControl.SetXonXoffIn(const Value: Boolean);
 843 begin
 844   if Value <> FXonXoffIn then
 845   begin
 846     FXonXoffIn := Value;
 847     if FComPort <> nil then
 848       FComPort.ApplyDCB;
 849   end;
 850 end;
 851
 852 // set software ouput flow control
 853 procedure TMHComFlowControl.SetXonXoffOut(const Value: Boolean);
 854 begin
 855   if Value <> FXonXoffOut then
 856   begin
 857     FXonXoffOut := Value;
 858     if FComPort <> nil then
 859       FComPort.ApplyDCB;
 860   end;
 861 end;
 862
 863 // set DSR sensitivity
 864 procedure TMHComFlowControl.SetDSRSensitivity(const Value: Boolean);
 865 begin
 866   if Value <> FDSRSensitivity then
 867   begin
 868     FDSRSensitivity := Value;
 869     if FComPort <> nil then
 870       FComPort.ApplyDCB;
 871   end;
 872 end;
 873
 874 // set transfer continue when Xoff is sent
 875 procedure TMHComFlowControl.SetTxContinueOnXoff(const Value: Boolean);
 876 begin
 877   if Value <> FTxContinueOnXoff then
 878   begin
 879     FTxContinueOnXoff := Value;
 880     if FComPort <> nil then
 881       FComPort.ApplyDCB;
 882   end;
 883 end;
 884
 885 // set Xon char
 886 procedure TMHComFlowControl.SetXonChar(const Value: Char);
 887 begin
 888   if Value <> FXonChar then
 889   begin
 890     FXonChar := Value;
 891     if FComPort <> nil then
 892       FComPort.ApplyDCB;
 893   end;
 894 end;
 895
 896 // set Xoff char
 897 procedure TMHComFlowControl.SetXoffChar(const Value: Char);
 898 begin
 899   if Value <> FXoffChar then
 900   begin
 901     FXoffChar := Value;
 902     if FComPort <> nil then
 903       FComPort.ApplyDCB;
 904   end;
 905 end;
 906
 907 // get common flow control
 908 function TMHComFlowControl.GetFlowControl: TFlowControl;
 909 begin
 910   if (FControlRTS = rtsHandshake) and (FOutCTSFlow)
 911     and (not FXonXoffIn) and (not FXonXoffOut)
 912   then
 913     Result := fcHardware
 914   else
 915     if (FControlRTS = rtsDisable) and (not FOutCTSFlow)
 916       and (FXonXoffIn) and (FXonXoffOut)
 917     then
 918       Result := fcSoftware
 919     else
 920       if (FControlRTS = rtsDisable) and (not FOutCTSFlow)
 921         and (not FXonXoffIn) and (not FXonXoffOut)
 922       then
 923         Result := fcNone
 924       else
 925         Result := fcCustom;
 926 end;
 927
 928 // set common flow control
 929 procedure TMHComFlowControl.SetFlowControl(const Value: TFlowControl);
 930 begin
 931   if Value <> fcCustom then
 932   begin
 933     FControlRTS := rtsDisable;
 934     FOutCTSFlow := False;
 935     FXonXoffIn := False;
 936     FXonXoffOut := False;
 937     case Value of
 938       fcHardware:
 939       begin
 940         FControlRTS := rtsHandshake;
 941         FOutCTSFlow := True;
 942       end;
 943       fcSoftware:
 944       begin
 945         FXonXoffIn := True;
 946         FXonXoffOut := True;
 947       end;
 948     end;
 949   end;
 950   if FComPort <> nil then
 951     FComPort.ApplyDCB;
 952 end;
 953
 954
 955 function NewMHComParity:PMHComParity;
 956 begin
 957   New(Result, Create);
 958   Result.FBits := prNone;
 959 end;
 960
 961 // copy properties to other class
 962 procedure TMHComParity.AssignTo(Dest:PObj);
 963 begin
 964   if TMHComParity.AncestorOfObject(Dest) then
 965   begin
 966     with PMHComParity(Dest)^ do
 967     begin
 968       FBits        := Self.Bits;
 969       FCheck       := Self.Check;
 970       FReplace     := Self.Replace;
 971       FReplaceChar := Self.ReplaceChar;
 972     end
 973   end
 974   else
 975     inherited;
 976 end;
 977
 978 // select TCustomComPort to own this class
 979 procedure TMHComParity.SetComPort(const AComPort: PMHComPort);
 980 begin
 981   FComPort := AComPort;
 982 end;
 983
 984 // set parity bits
 985 procedure TMHComParity.SetBits(const Value: TParityBits);
 986 begin
 987   if Value <> FBits then
 988   begin
 989     FBits := Value;
 990     if FComPort <> nil then
 991       FComPort.ApplyDCB;
 992   end;
 993 end;
 994
 995 // set check parity
 996 procedure TMHComParity.SetCheck(const Value: Boolean);
 997 begin
 998   if Value <> FCheck then
 999   begin
1000     FCheck := Value;
1001     if FComPort <> nil then
1002       FComPort.ApplyDCB;
1003   end;
1004 end;
1005
1006 // set replace on parity error
1007 procedure TMHComParity.SetReplace(const Value: Boolean);
1008 begin
1009   if Value <> FReplace then
1010   begin
1011     FReplace := Value;
1012     if FComPort <> nil then
1013       FComPort.ApplyDCB;
1014   end;
1015 end;
1016
1017 // set replace char
1018 procedure TMHComParity.SetReplaceChar(const Value: Char);
1019 begin
1020   if Value <> FReplaceChar then
1021   begin
1022     FReplaceChar := Value;
1023     if FComPort <> nil then
1024       FComPort.ApplyDCB;
1025   end;
1026 end;
1027
1028
1029 function NewMHComBuffer:PMHComBuffer;
1030 begin
1031   New(Result, Create);
1032   Result.FInputSize := 1024;
1033   Result.FOutputSize := 1024;
1034 end;
1035
1036 // copy properties to other class
1037 procedure TMHComBuffer.AssignTo(Dest: PObj);
1038 begin
1039   if TMHComBuffer.AncestorOfObject(Dest) then
1040   begin
1041     with PMHComBuffer(Dest)^ do
1042     begin
1043       FOutputSize  := Self.OutputSize;
1044       FInputSize   := Self.InputSize;
1045     end
1046   end
1047   else
1048     inherited;
1049 end;
1050
1051 // select TCustomComPort to own this class
1052 procedure TMHComBuffer.SetComPort(const AComPort: PMHComPort);
1053 begin
1054   FComPort := AComPort;
1055 end;
1056
1057 // set input size
1058 procedure TMHComBuffer.SetInputSize(const Value: Integer);
1059 begin
1060   if Value <> FInputSize then
1061   begin
1062     FInputSize := Value;
1063     if (FInputSize mod 2) = 1 then
1064       Dec(FInputSize);
1065     if FComPort <> nil then
1066       FComPort.ApplyBuffer;
1067   end;
1068 end;
1069
1070 // set ouput size
1071 procedure TMHComBuffer.SetOutputSize(const Value: Integer);
1072 begin
1073   if Value <> FOutputSize then
1074   begin
1075     FOutputSize := Value;
1076     if (FOutputSize mod 2) = 1 then
1077       Dec(FOutputSize);
1078     if FComPort <> nil then
1079       FComPort.ApplyBuffer;
1080   end;
1081 end;
1082
1083 function NewMHComPort(Wnd: PControl):PMHComPort;
1084 begin
1085   New(Result, Create);
1086 //  Result.FLinks := TList.Create;
1087   Result.FBaudRate := br9600;
1088   Result.FCustomBaudRate := 9600;
1089   Result.FPort := 'COM1';
1090   Result.FStopBits := sbOneStopBit;
1091   Result.FDataBits := dbEight;
1092   Result.FEvents := [evRxChar, evTxEmpty, evRxFlag, evRing, evBreak, evCTS, evDSR, evError, evRLSD, evRx80Full];
1093   Result.FHandle := INVALID_HANDLE_VALUE;
1094   Result.FStoredProps := [spBasic];
1095   Result.FParity := NewMHComParity;
1096   Result.FParity.SetComPort(Result);
1097   Result.FFlowControl := NewMHComFlowControl;
1098   Result.FFlowControl.SetComPort(Result);
1099   Result.FTimeouts := NewMHComTimeouts;
1100   Result.FTimeouts.SetComPort(Result);
1101   Result.FBuffer := NewMHComBuffer;
1102   Result.FBuffer.SetComPort(Result);
1103 end;
1104
1105
1106
1107 // destroy component
1108 destructor TMHComPort.Destroy;
1109 begin
1110   Close;
1111   FBuffer.Free;
1112   FFlowControl.Free;
1113   FTimeouts.Free;
1114   FParity.Free;
1115 //  FLinks.Free;
1116   inherited;
1117 end;
1118
1119 // create handle to serial port
1120 procedure TMHComPort.CreateHandle;
1121 var
1122   pc:PChar;
1123 begin
1124   pc:=PChar('\\.\'+FPort);
1125   FHandle := CreateFile(pc,//PChar('\\.\' + FPort),
1126     GENERIC_READ or GENERIC_WRITE,
1127     0,
1128     nil,
1129     OPEN_EXISTING,
1130     FILE_FLAG_OVERLAPPED,
1131     0);
1132
1133
1134 //if FHandle = INVALID_HANDLE_VALUE then
1135 //  ShowMessage('!!!');
1136 {    raise EComPort.Create(CError_OpenFailed, GetLastError);
1137 }
1138 end;
1139
1140 // destroy serial port handle
1141 procedure TMHComPort.DestroyHandle;
1142 begin
1143   if FHandle <> INVALID_HANDLE_VALUE then
1144     CloseHandle(FHandle);
1145 end;
1146
1147 procedure TMHComPort.Loaded;
1148 begin
1149 //  inherited Loaded;
1150   // open port if Connected is True at design-time
1151   if (FConnected) then
1152   begin
1153     FConnected := False;
1154
1155
1156  try
1157
1158       Open;
1159
1160     except
1161 //      on E:Exception do
1162 //        Application.ShowException(E);
1163     end;
1164
1165   end;
1166 end;
1167
1168 // call events which have been dispatch using window message
1169 procedure TMHComPort.WindowMethod(var Message: TMessage);
1170 begin
1171   with Message do
1172     if Msg = CM_COMPORT then
1173     begin
1174       case wParam of
1175         EV_RXCHAR:   CallRxChar;
1176         EV_TXEMPTY:  CallTxEmpty;
1177         EV_BREAK:    CallBreak;
1178         EV_RING:     CallRing;
1179         EV_CTS:      CallCTSChange;
1180         EV_DSR:      CallDSRChange;
1181         EV_RXFLAG:   CallRxFlag;
1182         EV_RLSD:     CallRLSDChange;
1183         EV_ERR:      CallError;
1184         EV_RX80FULL: CallRx80Full;
1185       end
1186     end
1187     else
1188       Result := DefWindowProc(FWindow, Msg, wParam, lParam);
1189 end;
1190
1191 // prevent from applying changes at runtime
1192 procedure TMHComPort.BeginUpdate;
1193 begin
1194   FUpdateCount := FUpdateCount + 1;
1195 end;
1196
1197 // apply the changes made since BeginUpdate call
1198 procedure TMHComPort.EndUpdate;
1199 begin
1200   if FUpdateCount > 0 then
1201   begin
1202     FUpdateCount := FUpdateCount - 1;
1203     if FUpdateCount = 0 then
1204       SetupComPort;
1205   end;
1206 end;
1207
1208 // open port
1209 procedure TMHComPort.Open;
1210 begin
1211   // if already connected, do nothing
1212   if (not FConnected) then
1213   begin
1214     CallBeforeOpen;
1215     // open port
1216     CreateHandle;
1217     FConnected := True;
1218     try
1219       // initialize port
1220       SetupComPort;
1221     except
1222       // error occured during initialization, destroy handle
1223       DestroyHandle;
1224       FConnected := False;
1225       raise;
1226     end;
1227     // if at least one event is set, create special thread to monitor port
1228     if (FEvents = []) then
1229       FThreadCreated := False
1230     else
1231     begin
1232 //      if (FSyncMethod = smWindowSync) then
1233 //        FWindow := AllocateHWnd(WindowMethod);
1234       FEventThread := NewMHComThread(@Self);
1235 //      FEventThread.OnExecute:=TOnThreadExecute(MHComThreadExecute(FEventThread));
1236       FEventThread.FThread.Resume;
1237       //TComThread.Create(Self);
1238       FThreadCreated := True;
1239     end;
1240     // port is succesfully opened, do any additional initialization
1241     CallAfterOpen;
1242   end;
1243 end;
1244
1245 // close port
1246 procedure TMHComPort.Close;
1247 begin
1248   // if already closed, do nothing
1249   if (FConnected) then
1250   begin
1251     CallBeforeClose;
1252     // abort all pending operations
1253     AbortAllAsync;
1254     // stop monitoring for events
1255     if FThreadCreated then
1256     begin
1257       FEventThread.Free;
1258       FThreadCreated := False;
1259 //      if FSyncMethod = smWindowSync then
1260 //        DeallocateHWnd(FWindow);
1261     end;
1262     // close port
1263     DestroyHandle;
1264     FConnected := False;
1265     // port is closed, do any additional finalization
1266     CallAfterClose;
1267   end;
1268 end;
1269
1270 // apply port properties
1271 procedure TMHComPort.ApplyDCB;
1272 const
1273   CParityBits: array[TParityBits] of Integer =
1274     (NOPARITY, ODDPARITY, EVENPARITY, MARKPARITY, SPACEPARITY);
1275   CStopBits: array[TStopBits] of Integer =
1276     (ONESTOPBIT, ONE5STOPBITS, TWOSTOPBITS);
1277   CBaudRate: array[TBaudRate] of Integer =
1278     (0, CBR_110, CBR_300, CBR_600, CBR_1200, CBR_2400, CBR_4800, CBR_9600,
1279      CBR_14400, CBR_19200, CBR_38400, CBR_56000, CBR_57600, CBR_115200,
1280      CBR_128000, CBR_256000);
1281   CDataBits: array[TDataBits] of Integer = (5, 6, 7, 8);
1282   CControlRTS: array[TRTSFlowControl] of Integer =
1283     (RTS_CONTROL_DISABLE shl 12,
1284      RTS_CONTROL_ENABLE shl 12,
1285      RTS_CONTROL_HANDSHAKE shl 12,
1286      RTS_CONTROL_TOGGLE shl 12);
1287   CControlDTR: array[TDTRFlowControl] of Integer =
1288     (DTR_CONTROL_DISABLE shl 4,
1289      DTR_CONTROL_ENABLE shl 4,
1290      DTR_CONTROL_HANDSHAKE shl 4);
1291
1292 var
1293   DCB: TDCB;
1294
1295 begin
1296   // if not connected or inside BeginUpdate/EndUpdate block, do nothing
1297   if (FConnected) and (FUpdateCount = 0) then
1298   begin
1299     DCB.DCBlength := SizeOf(TDCB);
1300     DCB.XonLim := FBuffer.InputSize div 4;
1301     DCB.XoffLim := DCB.XonLim;
1302     DCB.EvtChar := Char(FEventChar);
1303
1304     DCB.Flags := dcb_Binary;
1305     if FDiscardNull then
1306       DCB.Flags := DCB.Flags or dcb_Null;
1307
1308     with FFlowControl^ do
1309     begin
1310       DCB.XonChar := XonChar;
1311       DCB.XoffChar := XoffChar;
1312       if OutCTSFlow then
1313         DCB.Flags := DCB.Flags or dcb_OutxCTSFlow;
1314       if OutDSRFlow then
1315         DCB.Flags := DCB.Flags or dcb_OutxDSRFlow;
1316       DCB.Flags := DCB.Flags or CControlDTR[ControlDTR]
1317         or CControlRTS[ControlRTS];
1318       if XonXoffOut then
1319         DCB.Flags := DCB.Flags or dcb_OutX;
1320       if XonXoffIn then
1321         DCB.Flags := DCB.Flags or dcb_InX;
1322       if DSRSensitivity then
1323         DCB.Flags := DCB.Flags or dcb_DSRSensivity;
1324       if TxContinueOnXoff then
1325         DCB.Flags := DCB.Flags or dcb_TxContinueOnXoff;
1326     end;
1327
1328     DCB.Parity := CParityBits[FParity.Bits];
1329     DCB.StopBits := CStopBits[FStopBits];
1330     if FBaudRate <> brCustom then
1331       DCB.BaudRate := CBaudRate[FBaudRate]
1332     else
1333       DCB.BaudRate := FCustomBaudRate;
1334     DCB.ByteSize := CDataBits[FDataBits];
1335
1336     if FParity.Check then
1337     begin
1338       DCB.Flags := DCB.Flags or dcb_Parity;
1339       if FParity.Replace then
1340       begin
1341         DCB.Flags := DCB.Flags or dcb_ErrorChar;
1342         DCB.ErrorChar := Char(FParity.ReplaceChar);
1343       end;
1344     end;
1345
1346     // apply settings
1347
1348     SetCommState(FHandle, DCB);// then
1349 //      ShowMessage('!@!!');
1350 //      raise EComPort.Create(CError_SetStateFailed, GetLastError);
1351
1352   end;
1353 end;
1354
1355 // apply timeout properties
1356 procedure TMHComPort.ApplyTimeouts;
1357 var
1358   Timeouts2: TCommTimeouts;
1359
1360   function GetTOValue(const Value: Integer): DWORD;
1361   begin
1362     if Value = -1 then
1363       Result := MAXDWORD
1364     else
1365       Result := Value;
1366   end;
1367
1368 begin
1369   // if not connected or inside BeginUpdate/EndUpdate block, do nothing
1370   if (FConnected) and (FUpdateCount = 0) then
1371   begin
1372     Timeouts2.ReadIntervalTimeout := GetTOValue(FTimeouts.ReadInterval);
1373     Timeouts2.ReadTotalTimeoutMultiplier := GetTOValue(FTimeouts.ReadTotalMultiplier);
1374     Timeouts2.ReadTotalTimeoutConstant := GetTOValue(FTimeouts.ReadTotalConstant);
1375     Timeouts2.WriteTotalTimeoutMultiplier := GetTOValue(FTimeouts.WriteTotalMultiplier);
1376     Timeouts2.WriteTotalTimeoutConstant := GetTOValue(FTimeouts.WriteTotalConstant);
1377
1378     // apply settings
1379
1380    { if not}
1381     SetCommTimeouts(FHandle, Timeouts2);
1382 {     then
1383       raise EComPort.Create(CError_TimeoutsFailed, GetLastError);
1384  }
1385   end;
1386 end;
1387
1388 // apply buffers
1389 procedure TMHComPort.ApplyBuffer;
1390 begin
1391   // if not connected or inside BeginUpdate/EndUpdate block, do nothing
1392
1393   if (FConnected) and (FUpdateCount = 0) then
1394     //apply settings
1395  {   if not}
1396     SetupComm(FHandle, FBuffer.InputSize, FBuffer.OutputSize);
1397 {     then
1398       raise EComPort.Create(CError_SetupComFailed, GetLastError);
1399  }
1400 end;
1401
1402 // initialize port
1403 procedure TMHComPort.SetupComPort;
1404 begin
1405   ApplyBuffer;
1406   ApplyDCB;
1407   ApplyTimeouts;
1408 end;
1409
1410 // get number of bytes in input buffer
1411 function TMHComPort.InputCount: Integer;
1412 var
1413   Errors: DWORD;
1414   ComStat: TComStat;
1415 begin
1416
1417 {  if not}
1418   ClearCommError(FHandle, Errors, @ComStat);
1419 {  then
1420     raise EComPort.Create(CError_ClearComFailed, GetLastError);
1421  }
1422   Result := ComStat.cbInQue;
1423 end;
1424
1425 // get number of bytes in output buffer
1426 function TMHComPort.OutputCount: Integer;
1427 var
1428   Errors: DWORD;
1429   ComStat: TComStat;
1430 begin
1431
1432 //  if not
1433   ClearCommError(FHandle, Errors, @ComStat);
1434   // then
1435 //    raise EComPort.Create(CError_ClearComFailed, GetLastError);
1436
1437   Result := ComStat.cbOutQue;
1438 end;
1439
1440 // get signals which are in high state
1441 function TMHComPort.Signals: TComSignals;
1442 var
1443   Status: DWORD;
1444 begin
1445
1446 //  if not
1447   GetCommModemStatus(FHandle, Status);
1448 //  then
1449 //    raise EComPort.Create(CError_ModemStatFailed, GetLastError);
1450
1451   Result := [];
1452
1453   if (MS_CTS_ON and Status) <> 0 then
1454     Result := Result + [csCTS];
1455   if (MS_DSR_ON and Status) <> 0 then
1456     Result := Result + [csDSR];
1457   if (MS_RING_ON and Status) <> 0 then
1458     Result := Result + [csRing];
1459   if (MS_RLSD_ON and Status) <> 0 then
1460     Result := Result + [csRLSD];
1461 end;
1462
1463 // get port state flags
1464 function TMHComPort.StateFlags: TComStateFlags;
1465 var
1466   Errors: DWORD;
1467   ComStat: TComStat;
1468 begin
1469   (*
1470   if not*)
1471   ClearCommError(FHandle, Errors, @ComStat);
1472 (*  then
1473     raise EComPort.Create(CError_ClearComFailed, GetLastError);
1474    *)
1475   Result := ComStat.Flags;
1476 end;
1477
1478 // set hardware line break
1479 procedure TMHComPort.SetBreak(OnOff: Boolean);
1480 var
1481   Act: Integer;
1482 begin
1483   if OnOff then
1484     Act := Windows.SETBREAK
1485   else
1486     Act := Windows.CLRBREAK;
1487
1488   (*
1489   if not  *)
1490   EscapeCommFunction(FHandle, Act);
1491 (*  then
1492     raise EComPort.Create(CError_EscapeComFailed, GetLastError);
1493    *)
1494 end;
1495
1496 // set DTR signal
1497 procedure TMHComPort.SetDTR(OnOff: Boolean);
1498 var
1499   Act: DWORD;
1500 begin
1501   if OnOff then
1502     Act := Windows.SETDTR
1503   else
1504     Act := Windows.CLRDTR;
1505
1506   (*
1507   if not*)
1508   EscapeCommFunction(FHandle, Act)
1509 (*   then
1510     raise EComPort.Create(CError_EscapeComFailed, GetLastError);
1511    *)
1512 end;
1513
1514 // set RTS signals
1515 procedure TMHComPort.SetRTS(OnOff: Boolean);
1516 var
1517   Act: DWORD;
1518 begin
1519   if OnOff then
1520     Act := Windows.SETRTS
1521   else
1522     Act := Windows.CLRRTS;
1523
1524   (*
1525   if not*)
1526   EscapeCommFunction(FHandle, Act);
1527   (* then
1528     raise EComPort.Create(CError_EscapeComFailed, GetLastError);
1529    *)
1530 end;
1531
1532 // set XonXoff state
1533 procedure TMHComPort.SetXonXoff(OnOff: Boolean);
1534 var
1535   Act: DWORD;
1536 begin
1537   if OnOff then
1538     Act := Windows.SETXON
1539   else
1540     Act := Windows.SETXOFF;
1541
1542   {
1543   if not }
1544   EscapeCommFunction(FHandle, Act);
1545   {then
1546     raise EComPort.Create(CError_EscapeComFailed, GetLastError);
1547    }
1548 end;
1549
1550 // clear input and/or output buffer
1551 procedure TMHComPort.ClearBuffer(Input, Output: Boolean);
1552 var
1553   Flag: DWORD;
1554 begin
1555   Flag := 0;
1556   if Input then
1557     Flag := PURGE_RXCLEAR;
1558   if Output then
1559     Flag := Flag or PURGE_TXCLEAR;
1560
1561   {
1562   if not}
1563   PurgeComm(FHandle, Flag);
1564   {then
1565     raise EComPort.Create(CError_PurgeFailed, GetLastError);
1566    }
1567 end;
1568
1569 // return last errors on port
1570 {function TMHComPort.LastErrors: TComErrors;
1571 var
1572   Errors: DWORD;
1573   ComStat: TComStat;
1574 begin
1575   if not ClearCommError(FHandle, Errors, @ComStat) then
1576     raise EComPort.Create(CError_ClearComFailed, GetLastError);
1577   Result := [];
1578
1579   if (CE_FRAME and Errors) <> 0 then
1580     Result := Result + [ceFrame];
1581   if ((CE_RXPARITY and Errors) <> 0) and FParity.Check then // get around a bug
1582     Result := Result + [ceRxParity];
1583   if (CE_OVERRUN and Errors) <> 0 then
1584     Result := Result + [ceOverrun];
1585   if (CE_RXOVER and Errors) <> 0 then
1586     Result := Result + [ceRxOver];
1587   if (CE_TXFULL and Errors) <> 0 then
1588     Result := Result + [ceTxFull];
1589   if (CE_BREAK and Errors) <> 0 then
1590     Result := Result + [ceBreak];
1591   if (CE_IOE and Errors) <> 0 then
1592     Result := Result + [ceIO];
1593   if (CE_MODE and Errors) <> 0 then
1594     Result := Result + [ceMode];
1595 end;
1596  }
1597 // perform asynchronous write operation
1598 function TMHComPort.WriteAsync(const Buf; Count: Integer; var AsyncPtr: PAsync): Integer;
1599 var
1600   Success: Boolean;
1601   BytesTrans: DWORD;
1602 begin
1603   AsyncPtr^.Kind := okWrite;
1604
1605   Success := WriteFile(FHandle, Buf, Count, BytesTrans, @AsyncPtr^.Overlapped)
1606     or (GetLastError = ERROR_IO_PENDING);
1607
1608   (*
1609   if not Success then
1610     raise EComPort.Create(CError_WriteFailed, GetLastError);
1611    *)
1612
1613 //  SendSignals(lsTx, True);
1614   Result := BytesTrans;
1615 end;
1616
1617 // perform synchronous write operation
1618 function TMHComPort.Write(const Buf; Count: Integer): Integer;
1619 var
1620   AsyncPtr: PAsync;
1621 begin
1622   InitAsync(AsyncPtr);
1623   try
1624     WriteAsync(Buf, Count, AsyncPtr);
1625     Result := WaitForAsync(AsyncPtr);
1626   finally
1627     DoneAsync(AsyncPtr);
1628   end;
1629 end;
1630
1631 // perform asynchronous write operation
1632 function TMHComPort.WriteStrAsync(Str: string; var AsyncPtr: PAsync): Integer;
1633 var
1634   Success: Boolean;
1635   BytesTrans: DWORD;
1636 begin
1637   AsyncPtr^.Kind := okWrite;
1638
1639   Success := WriteFile(FHandle, Str[1], Length(Str), BytesTrans, @AsyncPtr^.Overlapped)
1640     or (GetLastError = ERROR_IO_PENDING);
1641
1642   (*
1643   if not Success then
1644     raise EComPort.Create(CError_WriteFailed, GetLastError);
1645    *)
1646
1647 //  SendSignals(lsTx, True);
1648   Result := BytesTrans;
1649 end;
1650
1651 // perform synchronous write operation
1652 function TMHComPort.WriteStr(Str: string): Integer;
1653 var
1654   AsyncPtr: PAsync;
1655 begin
1656   InitAsync(AsyncPtr);
1657   try
1658     WriteStrAsync(Str, AsyncPtr);
1659     Result := WaitForAsync(AsyncPtr);
1660   finally
1661     DoneAsync(AsyncPtr);
1662   end;
1663 end;
1664
1665 // perform asynchronous read operation
1666 function TMHComPort.ReadAsync(var Buf; Count: Integer; var AsyncPtr: PAsync): Integer;
1667 var
1668   Success: Boolean;
1669   BytesTrans: DWORD;
1670 begin
1671   AsyncPtr^.Kind := okRead;
1672
1673   Success := ReadFile(FHandle, Buf, Count, BytesTrans, @AsyncPtr^.Overlapped)
1674     or (GetLastError = ERROR_IO_PENDING);
1675
1676   (*
1677   if not Success then
1678     raise EComPort.Create(CError_ReadFailed, GetLastError);
1679   *)
1680
1681   Result := BytesTrans;
1682 end;
1683
1684 // perform synchronous read operation
1685 function TMHComPort.Read(var Buf; Count: Integer): Integer;
1686 var
1687   AsyncPtr: PAsync;
1688 begin
1689   InitAsync(AsyncPtr);
1690   try
1691     ReadAsync(Buf, Count, AsyncPtr);
1692     Result := WaitForAsync(AsyncPtr);
1693   finally
1694     DoneAsync(AsyncPtr);
1695   end;
1696 end;
1697
1698 // perform asynchronous read operation
1699 function TMHComPort.ReadStrAsync(var Str: string; Count: Integer; var AsyncPtr: PAsync): Integer;
1700 var
1701   Success: Boolean;
1702   BytesTrans: DWORD;
1703 begin
1704   AsyncPtr^.Kind := okRead;
1705   SetLength(Str, Count);
1706
1707   Success := ReadFile(FHandle, Str[1], Count, BytesTrans, @AsyncPtr^.Overlapped)
1708     or (GetLastError = ERROR_IO_PENDING);
1709
1710   (*
1711   if not Success then
1712     raise EComPort.Create(CError_ReadFailed, GetLastError);
1713    *)
1714
1715   Result := BytesTrans;
1716 end;
1717
1718 // perform synchronous read operation
1719 function TMHComPort.ReadStr(var Str: string; Count: Integer): Integer;
1720 var
1721   AsyncPtr: PAsync;
1722 begin
1723   InitAsync(AsyncPtr);
1724   try
1725     ReadStrAsync(Str, Count, AsyncPtr);
1726     Result := WaitForAsync(AsyncPtr);
1727     SetLength(Str, Result);
1728   finally
1729     DoneAsync(AsyncPtr);
1730   end;
1731 end;
1732
1733 function ErrorCode(AsyncPtr: PAsync): Integer;
1734 begin
1735   Result := 0;
1736  { case AsyncPtr^.Kind of
1737     okWrite: Result := CError_WriteFailed;
1738     okRead:  Result := CError_ReadFailed;
1739   end;}
1740 end;
1741
1742 // wait for asynchronous operation to end
1743 function TMHComPort.WaitForAsync(var AsyncPtr: PAsync): Integer;
1744 var
1745   BytesTrans, Signaled: DWORD;
1746   Success: Boolean;
1747 begin
1748   (*
1749   if AsyncPtr = nil then
1750     raise EComPort.CreateNoWinCode(CError_InvalidAsync);
1751    *)
1752
1753   Signaled := WaitForSingleObject(AsyncPtr^.Overlapped.hEvent, INFINITE);
1754   Success := (Signaled = WAIT_OBJECT_0) and
1755       (GetOverlappedResult(FHandle, AsyncPtr^.Overlapped, BytesTrans, False));
1756
1757 //  if (AsyncPtr^.Kind = okRead) and (InputCount = 0) then
1758 //    SendSignals(lsRx, False);
1759
1760   (*
1761   if not Success then
1762     raise EComPort.Create(ErrorCode(AsyncPtr), GetLastError);
1763    *)
1764
1765   Result := BytesTrans;
1766 end;
1767
1768 // abort all asynchronous operations
1769 procedure TMHComPort.AbortAllAsync;
1770 begin
1771   {
1772   if not}
1773    PurgeComm(FHandle, PURGE_TXABORT or PURGE_RXABORT);
1774    { then
1775     raise EComPort.Create(CError_PurgeFailed, GetLastError);
1776    }
1777 end;
1778
1779 // detect whether asynchronous operation is completed
1780 function TMHComPort.IsAsyncCompleted(AsyncPtr: PAsync): Boolean;
1781 var
1782   BytesTrans: DWORD;
1783 begin
1784   (*
1785   if AsyncPtr = nil then
1786     raise EComPort.CreateNoWinCode(CError_InvalidAsync);
1787   *)
1788
1789   Result := GetOverlappedResult(FHandle, AsyncPtr^.Overlapped, BytesTrans, False);
1790   (*
1791   if not Result then
1792     if GetLastError <> ERROR_IO_PENDING then
1793       raise EComPort.Create(CError_AsyncCheck, GetLastError);
1794    *)
1795 end;
1796
1797 // waits for event to occur on serial port
1798 procedure TMHComPort.WaitForEvent(var Events2: TComEvents; Timeout: Integer);
1799 var
1800   Overlapped: TOverlapped;
1801   Mask: DWORD;
1802   Success: Boolean;
1803   Signaled: Integer;
1804 begin
1805   (*
1806   if FThreadCreated then
1807     raise EComPort.CreateNoWinCode(CError_ThreadCreated);
1808   *)
1809   FillChar(Overlapped, SizeOf(TOverlapped), 0);
1810   Overlapped.hEvent := CreateEvent(nil, True, False, nil);
1811   try
1812     SetCommMask(FHandle, EventsToInt(Events2));
1813     Success := WaitCommEvent(FHandle, Mask, @Overlapped);
1814     if (Success) or (GetLastError = ERROR_IO_PENDING) then
1815     begin
1816       Signaled := WaitForSingleObject(Overlapped.hEvent, Timeout);
1817       if Signaled = WAIT_TIMEOUT then
1818         SetCommMask(FHandle, 0);
1819       Success := (Signaled = WAIT_OBJECT_0) or (Signaled = WAIT_TIMEOUT);
1820     end;
1821     (*
1822     if not Success then
1823       raise EComPort.Create(CError_WaitFailed, GetLastError);
1824     *)
1825     Events2 := IntToEvents(Mask);
1826   finally
1827     CloseHandle(Overlapped.hEvent);
1828   end;
1829 end;
1830
1831 // transmit char ahead of any pending data in ouput buffer
1832 procedure TMHComPort.TransmitChar(Ch: Char);
1833 begin
1834 {
1835   if not TransmitCommChar(FHandle, Ch) then
1836     raise EComPort.Create(CError_TransmitFailed, GetLastError);
1837     }
1838 end;
1839
1840 // some conversion routines
1841 function BoolToStr(const Value: Boolean): string;
1842 begin
1843   if Value then
1844     Result := 'Yes'
1845   else
1846     Result := 'No';
1847 end;
1848
1849 function StrToBool(const Value: string): Boolean;
1850 begin
1851   if UpperCase(Value) = 'YES' then
1852     Result := True
1853   else
1854     Result := False;
1855 end;
1856
1857 function DTRToStr(DTRFlowControl: TDTRFlowControl): string;
1858 const
1859   DTRStrings: array[TDTRFlowControl] of string = ('Disable', 'Enable',
1860     'Handshake');
1861 begin
1862   Result := DTRStrings[DTRFlowControl];
1863 end;
1864
1865 function RTSToStr(RTSFlowControl: TRTSFlowControl): string;
1866 const
1867   RTSStrings: array[TRTSFlowControl] of string = ('Disable', 'Enable',
1868     'Handshake', 'Toggle');
1869 begin
1870   Result := RTSStrings[RTSFlowControl];
1871 end;
1872
1873 function StrToRTS(Str: string): TRTSFlowControl;
1874 var
1875   I: TRTSFlowControl;
1876 begin
1877   I := Low(TRTSFlowControl);
1878   while (I <= High(TRTSFlowControl)) do
1879   begin
1880     if UpperCase(Str) = UpperCase(RTSToStr(I)) then
1881       Break;
1882     I := Succ(I);
1883   end;
1884   if I > High(TRTSFlowControl) then
1885     Result := rtsDisable
1886   else
1887     Result := I;
1888 end;
1889
1890 function StrToDTR(Str: string): TDTRFlowControl;
1891 var
1892   I: TDTRFlowControl;
1893 begin
1894   I := Low(TDTRFlowControl);
1895   while (I <= High(TDTRFlowControl)) do
1896   begin
1897     if UpperCase(Str) = UpperCase(DTRToStr(I)) then
1898       Break;
1899     I := Succ(I);
1900   end;
1901   if I > High(TDTRFlowControl) then
1902     Result := dtrDisable
1903   else
1904     Result := I;
1905 end;
1906
1907 function StrToChar(Str: string): Char;
1908 var
1909   A: Integer;
1910 begin
1911   if Length(Str) > 0 then
1912   begin
1913     if (Str[1] = '#') and (Length(Str) > 1) then
1914     begin
1915       try
1916         A := Str2Int(Copy(Str, 2, Length(Str) - 1));
1917       except
1918         A := 0;
1919       end;
1920       Result := Chr(Byte(A));
1921     end
1922     else
1923       Result := Str[1];
1924   end
1925   else
1926     Result := #0;
1927 end;
1928
1929 function CharToStr(Ch: Char): string;
1930 begin
1931   if Ch in [#33..#127] then
1932     Result := Ch
1933   else
1934     Result := '#' + Int2Str(Ord(Ch));
1935 end;
1936
1937
1938 // default actions on port events
1939
1940 procedure TMHComPort.DoBeforeClose;
1941 begin
1942   if Assigned(FOnBeforeClose) then
1943     FOnBeforeClose(@Self);
1944 end;
1945
1946 procedure TMHComPort.DoBeforeOpen;
1947 begin
1948   if Assigned(FOnBeforeOpen) then
1949     FOnBeforeOpen(@Self);
1950 end;
1951
1952 procedure TMHComPort.DoAfterOpen;
1953 begin
1954   if Assigned(FOnAfterOpen) then
1955     FOnAfterOpen(@Self);
1956 end;
1957
1958 procedure TMHComPort.DoAfterClose;
1959 begin
1960   if Assigned(FOnAfterClose) then
1961     FOnAfterClose(@Self);
1962 end;
1963
1964 procedure TMHComPort.DoRxChar(Count: Integer);
1965 begin
1966   if Assigned(FOnRxChar) then
1967     FOnRxChar(PObj(@Self), Count);
1968 end;
1969
1970 procedure TMHComPort.DoRxBuf(Buf:array of Byte; Count: Integer);
1971 begin
1972   if Assigned(FOnRxBuf) then
1973     FOnRxBuf(PObj(@Self), Buf, Count);
1974 end;
1975
1976 procedure TMHComPort.DoBreak;
1977 begin
1978   if Assigned(FOnBreak) then
1979     FOnBreak(@Self);
1980 end;
1981
1982 procedure TMHComPort.DoTxEmpty;
1983 begin
1984   if Assigned(FOnTxEmpty)
1985     then FOnTxEmpty(@Self);
1986 end;
1987
1988 procedure TMHComPort.DoRing;
1989 begin
1990   if Assigned(FOnRing) then
1991     FOnRing(@Self);
1992 end;
1993
1994 procedure TMHComPort.DoCTSChange(OnOff: Boolean);
1995 begin
1996   if Assigned(FOnCTSChange) then
1997     FOnCTSChange(PObj(@Self), OnOff);
1998 end;
1999
2000 procedure TMHComPort.DoDSRChange(OnOff: Boolean);
2001 begin
2002   if Assigned(FOnDSRChange) then
2003     FOnDSRChange(PObj(@Self), OnOff);
2004 end;
2005
2006 procedure TMHComPort.DoRLSDChange(OnOff: Boolean);
2007 begin
2008   if Assigned(FOnRLSDChange) then
2009     FOnRLSDChange(PObj(@Self), OnOff);
2010 end;
2011
2012 procedure TMHComPort.DoError(Errors: TComErrors);
2013 begin
2014   if Assigned(FOnError) then
2015     FOnError(PObj(@Self), Errors);
2016 end;
2017
2018 procedure TMHComPort.DoRxFlag;
2019 begin
2020   if Assigned(FOnRxFlag) then
2021     FOnRxFlag(@Self);
2022 end;
2023
2024 procedure TMHComPort.DoRx80Full;
2025 begin
2026   if Assigned(FOnRx80Full) then
2027     FOnRx80Full(@Self);
2028 end;
2029
2030 // set signals to false on close, and to proper value on open,
2031 // because OnXChange events are not called automatically
2032 procedure TMHComPort.CheckSignals(Open2: Boolean);
2033 begin
2034   if Open2 then
2035   begin
2036     CallCTSChange;
2037     CallDSRChange;
2038     CallRLSDChange;
2039   end else
2040   begin
2041 {    SendSignals(lsCTS, False);
2042     SendSignals(lsDSR, False);
2043     SendSignals(lsRLSD, False);}
2044     DoCTSChange(False);
2045     DoDSRChange(False);
2046     DoRLSDChange(False);
2047   end;
2048 end;
2049
2050 // called in response to EV_X events, except CallXClose, CallXOpen
2051
2052 procedure TMHComPort.CallAfterClose;
2053 begin
2054   DoAfterClose;
2055 end;
2056
2057 procedure TMHComPort.CallAfterOpen;
2058 begin
2059   DoAfterOpen;
2060   // check all com signals, since OnXChange events are not called on open
2061   CheckSignals(True);
2062 end;
2063
2064 procedure TMHComPort.CallBeforeClose;
2065 begin
2066   DoBeforeClose;
2067   // shutdown com signals manually
2068   CheckSignals(False);
2069 end;
2070
2071 procedure TMHComPort.CallBeforeOpen;
2072 begin
2073   DoBeforeClose;
2074 end;
2075
2076 procedure TMHComPort.CallBreak;
2077 begin
2078   DoBreak;
2079 end;
2080
2081 procedure TMHComPort.CallCTSChange;
2082 var
2083   OnOff: Boolean;
2084 begin
2085   OnOff := csCTS in Signals;
2086   // check for linked components
2087 //  SendSignals(lsCTS, OnOff);
2088   DoCTSChange(csCTS in Signals);
2089 end;
2090
2091 procedure TMHComPort.CallDSRChange;
2092 var
2093   OnOff: Boolean;
2094 begin
2095   OnOff := csDSR in Signals;
2096   // check for linked components
2097 //  SendSignals(lsDSR, OnOff);
2098   DoDSRChange(csDSR in Signals);
2099 end;
2100
2101 procedure TMHComPort.CallRLSDChange;
2102 var
2103   OnOff: Boolean;
2104 begin
2105   OnOff := csRLSD in Signals;
2106   // check for linked components
2107 //  SendSignals(lsRLSD, OnOff);
2108   DoRLSDChange(csRLSD in Signals);
2109 end;
2110
2111 procedure TMHComPort.CallError;
2112 begin
2113 //  DoError(LastErrors);
2114 end;
2115
2116 procedure TMHComPort.CallRing;
2117 begin
2118   DoRing;
2119 end;
2120
2121 procedure TMHComPort.CallRx80Full;
2122 begin
2123   DoRx80Full;
2124 end;
2125
2126 procedure TMHComPort.CallRxChar;
2127 var
2128   Count: Integer;
2129
2130   // check if any component is linked, to OnRxChar event
2131   procedure CheckLinks;
2132   var
2133     P: Pointer;
2134     ReadFromBuffer: Boolean;
2135   begin
2136     // examine links
2137     if (Count > 0){ and (FLinks.Count > 0)} then
2138     begin
2139       ReadFromBuffer := False;
2140       try
2141
2142         begin
2143
2144           begin
2145             // link to OnRxChar event found
2146             if not ReadFromBuffer then
2147             begin
2148               // TMHComPort must read from comport, so OnRxChar event is
2149               // not triggered
2150               GetMem(P, Count);
2151               ReadFromBuffer := True;
2152               Read(P^, Count);
2153               // instead, call OnRxBuf event
2154               DoRxBuf(Byte(P^), Count);
2155             end;
2156
2157
2158           end
2159         end;
2160       finally
2161         if ReadFromBuffer then
2162         begin
2163           FreeMem(P);
2164           // data is already out of buffer, prevent from OnRxChar event to occur
2165           Count := 0;
2166         end;
2167       end;
2168     end;
2169   end;
2170
2171 begin
2172   Count := InputCount;
2173
2174   if Count > 0 then
2175     DoRxChar(Count);
2176 end;
2177
2178 procedure TMHComPort.CallRxFlag;
2179 begin
2180   DoRxFlag;
2181 end;
2182
2183 procedure TMHComPort.CallTxEmpty;
2184 begin
2185 //  SendSignals(lsTx, False);
2186   DoTxEmpty;
2187 end;
2188
2189 // send signals to linked components
2190
2191 // set connected property, same as Open/Close methods
2192 procedure TMHComPort.SetConnected(const Value: Boolean);
2193 begin
2194   if Value <> FConnected then
2195     if Value then
2196       Open
2197     else
2198       Close
2199   else
2200     FConnected := Value;
2201 end;
2202
2203 // set baud rate
2204 procedure TMHComPort.SetBaudRate(const Value: TBaudRate);
2205 begin
2206   if Value <> FBaudRate then
2207   begin
2208     FBaudRate := Value;
2209     // if possible, apply settings
2210     ApplyDCB;
2211   end;
2212 end;
2213
2214 // set custom baud rate
2215 procedure TMHComPort.SetCustomBaudRate(const Value: Integer);
2216 begin
2217   if Value <> FCustomBaudRate then
2218   begin
2219     FCustomBaudRate := Value;
2220     ApplyDCB;
2221   end;
2222 end;
2223
2224 // set data bits
2225 procedure TMHComPort.SetDataBits(const Value: TDataBits);
2226 begin
2227   if Value <> FDataBits then
2228   begin
2229     FDataBits := Value;
2230     ApplyDCB;
2231   end;
2232 end;
2233
2234 // set discard null charachters
2235 procedure TMHComPort.SetDiscardNull(const Value: Boolean);
2236 begin
2237   if Value <> FDiscardNull then
2238   begin
2239     FDiscardNull := Value;
2240     ApplyDCB;
2241   end;
2242 end;
2243
2244 // set event charachters
2245 procedure TMHComPort.SetEventChar(const Value: Char);
2246 begin
2247   if Value <> FEventChar then
2248   begin
2249     FEventChar := Value;
2250     ApplyDCB;
2251   end;
2252 end;
2253
2254 // translated numeric string to port string
2255 function ComString(Str: string): TPort;
2256 var
2257   Num: Integer;
2258 begin
2259   if UpperCase(Copy(Str, 1, 3)) = 'COM' then
2260     Str := Copy(Str, 4, Length(Str) - 3);
2261   try
2262     Num := Str2Int(Str);
2263   except
2264     Num := 1;
2265   end;
2266   if (Num < 1) or (Num > 16) then
2267     Num := 1;
2268   Result := Format('COM%d', [Num]);
2269 end;
2270
2271 // set port
2272 procedure TMHComPort.SetPort(const Value: TPort);
2273 var
2274   Str: string;
2275 begin
2276   Str := ComString(Value);
2277   if Str <> FPort then
2278   begin
2279     FPort := Str;
2280     if (FConnected)  then
2281     begin
2282       Close;
2283       Open;
2284     end;
2285   end;
2286 end;
2287
2288 // set stop bits
2289 procedure TMHComPort.SetStopBits(const Value: TStopBits);
2290 begin
2291   if Value <> FStopBits then
2292   begin
2293     FStopBits := Value;
2294     ApplyDCB;
2295   end;
2296 end;
2297
2298 // set event synchronization method
2299 procedure TMHComPort.SetSyncMethod(const Value: TSyncMethod);
2300 begin
2301   if Value <> FSyncMethod then
2302   begin
2303     if (FConnected)
2304     then
2305 //      raise EComPort.CreateNoWinCode(CError_SyncMeth)
2306     else
2307       FSyncMethod := Value;
2308   end;
2309 end;
2310
2311 // returns true if RxChar is triggered when data arrives input buffer
2312 function TMHComPort.GetTriggersOnRxChar: Boolean;
2313 begin
2314   Result := True;
2315 end;
2316
2317 // set flow control
2318 procedure TMHComPort.SetFlowControl(const Value: PMHComFlowControl);
2319 begin
2320   FFlowControl.AssignTo(Value);
2321   ApplyDCB;
2322 end;
2323
2324 // set parity
2325 procedure TMHComPort.SetParity(const Value: PMHComParity);
2326 begin
2327   FParity.AssignTo(Value);
2328   ApplyDCB;
2329 end;
2330
2331 // set timeouts
2332 procedure TMHComPort.SetTimeouts(const Value: PMHComTimeouts);
2333 begin
2334   FTimeouts.AssignTo(Value);
2335   ApplyTimeouts;
2336 end;
2337
2338 // set buffer
2339 procedure TMHComPort.SetBuffer(const Value: PMHComBuffer);
2340 begin
2341   FBuffer.AssignTo(Value);
2342   ApplyBuffer;
2343 end;
2344
2345 function BaudRateToStr(BaudRate: TBaudRate): string;
2346 const
2347   BaudRateStrings: array[TBaudRate] of string = ('Custom', '110', '300', '600',
2348     '1200', '2400', '4800', '9600', '14400', '19200', '38400', '56000', '57600',
2349     '115200', '128000', '256000');
2350 begin
2351   Result := BaudRateStrings[BaudRate];
2352 end;
2353
2354 // string to baud rate
2355 function StrToBaudRate(Str: string): TBaudRate;
2356 var
2357   I: TBaudRate;
2358 begin
2359   I := Low(TBaudRate);
2360   while (I <= High(TBaudRate)) do
2361   begin
2362     if UpperCase(Str) = UpperCase(BaudRateToStr(TBaudRate(I))) then
2363       Break;
2364     I := Succ(I);
2365   end;
2366   if I > High(TBaudRate) then
2367     Result := br9600
2368   else
2369     Result := I;
2370 end;
2371
2372 function FlowControlToStr(FlowControl: TFlowControl): string;
2373 const
2374   FlowControlStrings: array[TFlowControl] of string = ('Hardware',
2375     'Software', 'None', 'Custom');
2376 begin
2377   Result := FlowControlStrings[FlowControl];
2378 end;
2379
2380 function StopBitsToStr(StopBits: TStopBits): string;
2381 const
2382   StopBitsStrings: array[TStopBits] of string = ('1', '1.5', '2');
2383 begin
2384   Result := StopBitsStrings[StopBits];
2385 end;
2386
2387 // string to stop bits
2388 function StrToStopBits(Str: string): TStopBits;
2389 var
2390   I: TStopBits;
2391 begin
2392   I := Low(TStopBits);
2393   while (I <= High(TStopBits)) do
2394   begin
2395     if UpperCase(Str) = UpperCase(StopBitsToStr(TStopBits(I))) then
2396       Break;
2397     I := Succ(I);
2398   end;
2399   if I > High(TStopBits) then
2400     Result := sbOneStopBit
2401   else
2402     Result := I;
2403 end;
2404
2405 function DataBitsToStr(DataBits: TDataBits): string;
2406 const
2407   DataBitsStrings: array[TDataBits] of string = ('5', '6', '7', '8');
2408 begin
2409   Result := DataBitsStrings[DataBits];
2410 end;
2411
2412 // string to data bits
2413 function StrToDataBits(Str: string): TDataBits;
2414 var
2415   I: TDataBits;
2416 begin
2417   I := Low(TDataBits);
2418   while (I <= High(TDataBits)) do
2419   begin
2420     if UpperCase(Str) = UpperCase(DataBitsToStr(I)) then
2421       Break;
2422     I := Succ(I);
2423   end;
2424   if I > High(TDataBits) then
2425     Result := dbEight
2426   else
2427     Result := I;
2428 end;
2429 function ParityToStr(Parity: TParityBits): string;
2430 const
2431   ParityBitsStrings: array[TParityBits] of string = ('None', 'Odd', 'Even',
2432     'Mark', 'Space');
2433 begin
2434   Result := ParityBitsStrings[Parity];
2435 end;
2436
2437 // string to parity
2438 function StrToParity(Str: string): TParityBits;
2439 var
2440   I: TParityBits;
2441 begin
2442   I := Low(TParityBits);
2443   while (I <= High(TParityBits)) do
2444   begin
2445     if UpperCase(Str) = UpperCase(ParityToStr(I)) then
2446       Break;
2447     I := Succ(I);
2448   end;
2449   if I > High(TParityBits) then
2450     Result := prNone
2451   else
2452     Result := I;
2453 end;
2454
2455
2456 // string to flow control
2457 function StrToFlowControl(Str: string): TFlowControl;
2458 var
2459   I: TFlowControl;
2460 begin
2461   I := Low(TFlowControl);
2462   while (I <= High(TFlowControl)) do
2463   begin
2464     if UpperCase(Str) = UpperCase(FlowControlToStr(I)) then
2465       Break;
2466     I := Succ(I);
2467   end;
2468   if I > High(TFlowControl) then
2469     Result := fcCustom
2470   else
2471     Result := I;
2472 end;
2473
2474 end.