home *** CD-ROM | disk | FTP | other *** search
/ synchro.net / synchro.net.tar / synchro.net / main / BBS / D32_01.ZIP / WIN32COM.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  2000-07-25  |  23.7 KB  |  763 lines
  1. unit WIN32COM;
  2. (*
  3. **
  4. ** Serial and TCP/IP communication routines for DOS, OS/2 and Win9x/NT.
  5. ** Tested with: TurboPascal   v7.0,    (DOS)
  6. **              VirtualPascal v2.0,    (OS/2, Win32)
  7. **              FreePascal    v0.99.12 (DOS, Win32)
  8. **              Delphi        v4.0.    (Win32)
  9. **
  10. ** Version : 1.01
  11. ** Created : 21-May-1998
  12. ** Last update : 14-May-1999
  13. **
  14. ** Note: (c) 1998-1999 by Maarten Bekers
  15. **
  16. *)
  17.  
  18. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  19.  INTERFACE
  20. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  21.  
  22. uses Windows, Combase, BufUnit, Threads
  23.      {$IFDEF VirtualPascal}
  24.        ,Use32
  25.      {$ENDIF};
  26.  
  27. Const WriteTimeout   = 20000;                             { Wait max. 20 secs }
  28.       ReadTimeOut    = 20000;                    { General event, 20 secs max }
  29.  
  30.       InBufSize      = 1024 * 32;
  31.       OutBufSize     = 1024 * 32;
  32.  
  33.       ThreadsInitted : Boolean = false;
  34.  
  35.  
  36. type TWin32Obj = Object(TCommObj)
  37.         constructor Init;
  38.         destructor Done;
  39.  
  40.         function  Com_Open(Comport: Byte; BaudRate: Longint; DataBits: Byte;
  41.                            Parity: Char; StopBits: Byte): Boolean; virtual;
  42.         function  Com_OpenKeep(Comport: Byte): Boolean; virtual;
  43.         function  Com_GetChar: Char; virtual;
  44.         function  Com_CharAvail: Boolean; virtual;
  45.         function  Com_Carrier: Boolean; virtual;
  46.         function  Com_SendChar(C: Char): Boolean; virtual;
  47.         function  Com_ReadyToSend(BlockLen: Longint): Boolean; virtual;
  48.         function  Com_GetBPSrate: Longint; virtual;
  49.         function  Com_GetHandle: Longint; virtual;
  50.  
  51.         procedure Com_OpenQuick(Handle: Longint); virtual;
  52.         procedure Com_Close; virtual;
  53.         procedure Com_SendBlock(var Block; BlockLen: Longint; var Written: Longint); virtual;
  54.         procedure Com_ReadBlock(var Block; BlockLen: Longint; var Reads: Longint); virtual;
  55.         procedure Com_GetBufferStatus(var InFree, OutFree, InUsed, OutUsed: Longint); virtual;
  56.         procedure Com_SetDtr(State: Boolean); virtual;
  57.         procedure Com_GetModemStatus(var LineStatus, ModemStatus: Byte); virtual;
  58.         procedure Com_SetLine(BpsRate: longint; Parity: Char; DataBits, Stopbits: Byte); virtual;
  59.         procedure Com_PurgeInBuffer; virtual;
  60.         procedure Com_PurgeOutBuffer; virtual;
  61.  
  62.         procedure Com_PauseCom(CloseCom: Boolean); virtual;
  63.         procedure Com_ResumeCom(OpenCom: Boolean); virtual;
  64.         procedure Com_SetFlow(SoftTX, SoftRX, Hard: Boolean); virtual;
  65.      end; { object TWin32Obj }
  66.  
  67. type PWin32Obj = ^TWin32Obj;
  68.  
  69. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  70.  IMPLEMENTATION
  71. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  72.  
  73. uses SysUtils;
  74.  
  75. const
  76.   dcb_Binary              = $00000001;
  77.   dcb_ParityCheck         = $00000002;
  78.   dcb_OutxCtsFlow         = $00000004;
  79.   dcb_OutxDsrFlow         = $00000008;
  80.   dcb_DtrControlMask      = $00000030;
  81.   dcb_DtrControlDisable   = $00000000;
  82.   dcb_DtrControlEnable    = $00000010;
  83.   dcb_DtrControlHandshake = $00000020;
  84.   dcb_DsrSensivity        = $00000040;
  85.   dcb_TXContinueOnXoff    = $00000080;
  86.   dcb_OutX                = $00000100;
  87.   dcb_InX                 = $00000200;
  88.   dcb_ErrorChar           = $00000400;
  89.   dcb_NullStrip           = $00000800;
  90.   dcb_RtsControlMask      = $00003000;
  91.   dcb_RtsControlDisable   = $00000000;
  92.   dcb_RtsControlEnable    = $00001000;
  93.   dcb_RtsControlHandshake = $00002000;
  94.   dcb_RtsControlToggle    = $00003000;
  95.   dcb_AbortOnError        = $00004000;
  96.   dcb_Reserveds           = $FFFF8000;
  97.  
  98. var SaveHandle    : THandle;
  99.  
  100.     InitPortNr    : Longint;
  101.     InitHandle    : Longint;
  102.  
  103.     ReadOL        : TOverLapped;          { Overlapped structure for ReadFile }
  104.     WriteOL       : TOverLapped;         { Overlapped structure for WriteFile }
  105.  
  106.     InBuffer      : ^BufArrayObj;             { Buffer system internally used }
  107.     OutBuffer     : ^BufArrayObj;
  108.  
  109.     ReadEvent     : PSysEventObj;  { Event set by ReadFile overlapped routine }
  110.     WriteEvent    : PSysEventObj; { Event set by WriteFile overlapped routine }
  111.  
  112.     DoTxEvent     : PSysEventObj;{ Event manually set when we have to transmit }
  113.  
  114.     TxClosedEvent : PSysEventObj;    { Event set when the Tx thread is closed }
  115.     RxClosedEvent : PSysEventObj;    { Event set when the Rx thread is closed }
  116.  
  117.     CriticalTx    : PExclusiveObj;                        { Critical sections }
  118.     CriticalRx    : PExclusiveObj;
  119.  
  120.     TxThread      : PThreadsObj;           { The Transmit and Receive threads }
  121.     RxThread      : PThreadsObj;
  122.  
  123.     EndThreads    : Boolean;    { Set to true when we have to end the threads }
  124.  
  125. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  126.  
  127. constructor TWin32Obj.Init;
  128. begin
  129.   inherited Init;
  130.  
  131.   InitPortNr := -1;
  132.   InitHandle := -1;
  133. end; { constructor Init }
  134.  
  135. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  136.  
  137. destructor TWin32Obj.Done;
  138. begin
  139.   inherited done;
  140. end; { destructor Done }
  141.  
  142. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  143.  
  144. procedure ComReadProc(var TempPtr: Pointer);
  145. var EventMask : DWORD;
  146.     Success   : Boolean;
  147.     Props     : TCommProp;
  148.     ReturnCode: Longint;
  149.     DidRead   : DWORD;
  150.     BlockLen  : Longint;
  151.  
  152.     RecvOL    : tOverlapped;
  153.     RecvEvent : PSysEventObj;
  154. begin
  155.   New(RecvEvent, Init);
  156.   if NOT RecvEvent^.CreateEvent(true) then EXIT;
  157.  
  158.   FillChar(RecvOL, SizeOf(tOverLapped), 0);
  159.   RecvOL.hEvent := RecvEvent^.SemHandle;
  160.  
  161.   EventMask := EV_RXCHAR;
  162.   SetCommMask(SaveHandle, EventMask);     { Signal us if anything is received }
  163.  
  164.   repeat
  165.      WaitCommEvent(SaveHandle, EventMask, @RecvOL);
  166.      if EndThreads then EXIT;
  167.  
  168.      repeat
  169.         ReturnCode := WaitForSingleObject(RecvOL.hEvent, 500);
  170.         if ReturnCode = WAIT_OBJECT_0 then
  171.          begin
  172.            Success := true
  173.          end { if }
  174.            else Success := false;
  175.  
  176.         if EndThreads then BREAK;
  177.      until (Success);
  178.  
  179.      DidRead := 00;
  180.  
  181.      if (NOT Success) OR (EventMask = 0) then EXIT;
  182.      if (EndThreads) then EXIT;
  183.  
  184.      {----------------- Start reading the gathered date ---------------------}
  185.      CriticalRx^.EnterExclusive;
  186.  
  187.      FillChar(Props, SizeOf(TCommProp), 0);
  188.  
  189.      if GetCommProperties(SaveHandle, Props) then
  190.       if InBuffer^.BufRoom > 0 then
  191.         begin
  192.           BlockLen := Props.dwCurrentRxQueue;
  193.  
  194.           if BlockLen > InBuffer^.BufRoom then
  195.             BlockLen := InBuffer^.BufRoom;
  196.  
  197.           Success := ReadFile(SaveHandle,
  198.                               InBuffer^.TmpBuf^,
  199.                               BlockLen,
  200.                               DidRead,
  201.                               @ReadOL);
  202.  
  203.           if NOT Success then
  204.             begin
  205.               ReturnCode := GetLastError;
  206.  
  207.               if ReturnCode = ERROR_IO_PENDING then
  208.                 begin
  209.                   ReturnCode := WaitForSingleObject(ReadOL.hEvent, ReadTimeOut);
  210.  
  211.                   if ReturnCode = WAIT_OBJECT_0 then
  212.                     begin
  213.                       GetOverLappedResult(SaveHandle, ReadOL, DidRead, false);
  214.                     end; { if }
  215.                 end; { if }
  216.             end
  217.               else GetOverlappedResult(SaveHandle, ReadOL, DidRead, false);
  218.  
  219.           if DidRead > 00 then
  220.             InBuffer^.Put(InBuffer^.TmpBuf^, DidRead);
  221.        end; { if }
  222.  
  223.      CriticalRx^.LeaveExclusive;
  224.   until EndThreads;
  225.  
  226.   RxClosedEvent^.SignalEvent;
  227.   ExitThisThread;
  228. end; { proc. ComReadProc }
  229.  
  230. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  231.  
  232. procedure ComWriteProc(var TempPtr: Pointer);
  233. var BlockLen  : Longint;
  234.     Written   : DWORD;
  235.     ReturnCode: Longint;
  236.     Success   : Boolean;
  237. begin
  238.   repeat
  239.      if DoTxEvent^.WaitForEvent(WriteTimeOut) then
  240.       if NOT EndThreads then
  241.        begin
  242.          CriticalTx^.EnterExclusive;
  243.          DoTxEvent^.ResetEvent;
  244.  
  245.          if OutBuffer^.BufUsed > 00 then
  246.            begin
  247.              Written := 00;
  248.              BlockLen := OutBuffer^.Get(OutBuffer^.TmpBuf^, OutBuffer^.BufUsed, false);
  249.  
  250.              Success := WriteFile(SaveHandle,
  251.                                   OutBuffer^.TmpBuf^,
  252.                                   BlockLen,
  253.                                   Written,
  254.                                   @WriteOL);
  255.              if NOT Success then
  256.                begin
  257.                  ReturnCode := GetLastError;
  258.  
  259.                  if ReturnCode = ERROR_IO_PENDING then
  260.                    begin
  261.                      ReturnCode := WaitForSingleObject(WriteOL.hEvent, WriteTimeOut);
  262.  
  263.                      if ReturnCode = WAIT_OBJECT_0 then
  264.                        begin
  265.                          if GetOverLappedResult(SaveHandle, WriteOL, Written, false) then
  266.                            begin
  267.                              ResetEvent(WriteOL.hEvent);
  268.                            end; { if }
  269.                        end; { if }
  270.                    end; { result is pending }
  271.                end { if }
  272.                  else begin
  273.  
  274.                          if GetOverLappedResult(SaveHandle, WriteOL, Written, false) then
  275.                            begin
  276.                              ResetEvent(WriteOL.hEvent);
  277.                            end; { if }
  278.                       end; { if (did succeed) }
  279.  
  280.              ReturnCode := OutBuffer^.Get(OutBuffer^.TmpBuf^, Written, true);
  281.              if Written <> BlockLen then
  282.                DoTxEvent^.SignalEvent;
  283.            end; { if }
  284.  
  285.          CriticalTx^.LeaveExclusive;
  286.        end; { if }
  287.  
  288.   until EndThreads;
  289.  
  290.   TxClosedEvent^.SignalEvent;
  291.   ExitThisThread;
  292. end; { proc. ComWriteProc }
  293.  
  294. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  295.  
  296. function Com_StartThread: Boolean;
  297. begin
  298.   Result := false;
  299.   EndThreads := false;
  300.   if ThreadsInitted then EXIT;
  301.   ThreadsInitted := true;
  302.  
  303.   {----------------------- Create all the events ----------------------------}
  304.   New(ReadEvent, Init);
  305.   if NOT ReadEvent^.CreateEvent(true) then EXIT;
  306.  
  307.   New(WriteEvent, Init);
  308.   if NOT WriteEvent^.CreateEvent(true) then EXIT;
  309.  
  310.   New(DoTxEvent, Init);
  311.   if NOT DoTxEvent^.CreateEvent(true) then EXIT;
  312.  
  313.   New(RxClosedEvent, Init);
  314.   if NOT RxClosedEvent^.CreateEvent(false) then EXIT;
  315.  
  316.   New(TxClosedEvent, Init);
  317.   if NOT TxClosedEvent^.CreateEvent(false) then EXIT;
  318.  
  319.  
  320.  
  321.   {-------------- Startup the buffers and overlapped events -----------------}
  322.   FillChar(WriteOL, SizeOf(tOverLapped), 0);
  323.   FillChar(ReadOL, SizeOf(tOverLapped), 0);
  324.   WriteOl.hEvent := WriteEvent^.SemHandle;
  325.   ReadOl.hEvent := ReadEvent^.SemHandle;
  326.  
  327.   New(InBuffer, Init(InBufSize));
  328.   New(OutBuffer, Init(OutBufSize));
  329.  
  330.   if (InBuffer^.TxtArr=nil) OR (InBuffer^.TmpBuf=nil) then EXIT;
  331.   if (OutBuffer^.TxtArr=nil) OR (OutBuffer^.TmpBuf=nil) then EXIT;
  332.  
  333.   {-------------------- Startup a seperate write thread ---------------------}
  334.   New(CriticalTx, Init);
  335.   CriticalTx^.CreateExclusive;
  336.  
  337.   New(TxThread, Init);
  338.   if NOT TxThread^.CreateThread(16384,                           { Stack size }
  339.                                 @ComWriteProc,             { Actual procedure }
  340.                                 nil,                             { Parameters }
  341.                                 0)                           { Creation flags }
  342.                                  then EXIT;
  343.  
  344.   {-------------------- Startup a seperate read thread ----------------------}
  345.   New(CriticalRx, Init);
  346.   CriticalRx^.CreateExclusive;
  347.  
  348.   New(RxThread, Init);
  349.   if NOT RxThread^.CreateThread(16384,                           { Stack size }
  350.                                 @ComReadProc,              { Actual procedure }
  351.                                 nil,                             { Parameters }
  352.                                 0)                           { Creation flags }
  353.                                  then EXIT;
  354.  
  355.   Result := true;
  356. end; { proc. Com_StartThread }
  357.  
  358. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  359.  
  360. procedure Com_InitVars;
  361. begin
  362.   DoTxEvent := nil;
  363.   RxClosedEvent := nil;
  364.   TxClosedEvent := nil;
  365.   TxThread := nil;
  366.   RxThread := nil;
  367.  
  368.   InBuffer := nil;
  369.   OutBuffer := nil;
  370.   CriticalRx := nil;
  371.   CriticalTx := nil;
  372. end; { proc. Com_InitVars }
  373.  
  374. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  375.  
  376. procedure Com_StopThread;
  377. begin
  378.   EndThreads := true;
  379.   ThreadsInitted := false;
  380.  
  381.   if DoTxEvent <> nil then DoTxEvent^.SignalEvent;
  382.  
  383.   if TxThread <> nil then TxThread^.CloseThread;
  384.   if RxThread <> nil then RxThread^.CloseThread;
  385.  
  386.   if TxClosedEvent <> nil then
  387.    if NOT TxClosedEvent^.WaitForEvent(1000) then
  388.      TxThread^.TerminateThread(0);
  389.  
  390.   if RxClosedEvent <> nil then
  391.    if NOT RxClosedEvent^.WaitForEvent(1000) then
  392.      RxThread^.TerminateThread(0);
  393.  
  394.   if TxThread <> nil then Dispose(TxThread, Done);
  395.   if RxThread <> nil then Dispose(RxThread, Done);
  396.   if DoTxEvent <> nil then Dispose(DoTxEvent, Done);
  397.   if RxClosedEvent <> nil then Dispose(RxClosedEvent, Done);
  398.   if TxClosedEvent <> nil then Dispose(TxClosedEvent, Done);
  399.  
  400.   if CriticalTx <> nil then Dispose(CriticalTx, Done);
  401.   if CriticalRx <> nil then Dispose(CriticalRx, Done);
  402.  
  403.   if InBuffer <> nil then Dispose(InBuffer, Done);
  404.   if OutBuffer <> nil then Dispose(OutBuffer, Done);
  405.  
  406.   Com_InitVars;
  407. end; { proc. Com_StopThread }
  408.  
  409. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  410.  
  411. procedure InitDelayTimes;
  412. var CommTimeOut: TCommTimeouts;
  413.     RC         : Longint;
  414. begin
  415.   FillChar(CommTimeOut, SizeOf(TCommTimeOuts), 00);
  416.   CommTimeOut.ReadIntervalTimeout := MAXDWORD;
  417.  
  418.   if NOT SetCommTimeOuts(SaveHandle, CommTimeOut) then
  419.     begin
  420.        RC := GetLastError;
  421.        { ErrorStr := 'Error setting communications timeout: #'+IntToStr(RC) + ' / ' + SysErrorMessage(rc)); }
  422.     end; { if }
  423.  
  424. end; { proc. InitDelayTimes }
  425.  
  426. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  427.  
  428. function TWin32Obj.Com_GetHandle: Longint;
  429. begin
  430.   Result := SaveHandle;
  431. end; { func. Com_GetHandle }
  432.  
  433. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  434.  
  435. procedure TWin32Obj.Com_OpenQuick(Handle: Longint);
  436. var LastError: Longint;
  437. begin
  438.   SaveHandle := Handle;
  439.   InitHandle := Handle;
  440.  
  441.   FillChar(ReadOl, SizeOf(ReadOl), 00);
  442.   FillChar(WriteOl, SizeOf(WriteOl), 00);
  443.  
  444.   InitDelayTimes;
  445.  
  446.   if NOT SetupComm(Com_GetHandle, 1024, 1024) then
  447.     begin
  448.       LastError := GetLastError;
  449.  
  450.       { ErrorStr := 'Error setting up communications buffer: #'+IntToStr(LastError) + ' / '+SysErrorMessage(LastError); }
  451.     end; { if }
  452.  
  453.   InitFailed := NOT Com_StartThread;
  454.   Com_SetLine(-1, 'N', 8, 1);
  455. end; { proc. TWin32Obj.Com_OpenQuick }
  456.  
  457. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  458.  
  459. function TWin32Obj.Com_OpenKeep(Comport: Byte): Boolean;
  460. var TempSave   : THandle;
  461.     CommTimeOut: TCommTimeOuts;
  462.     Security   : TSECURITYATTRIBUTES;
  463.     LastError  : Longint;
  464. begin
  465.   InitPortNr := Comport;
  466.  
  467.   FillChar(ReadOl, SizeOf(ReadOl), 00);
  468.   FillChar(WriteOl, SizeOf(WriteOl), 00);
  469.  
  470.   FillChar(Security, SizeOf(TSECURITYATTRIBUTES), 0);
  471.   Security.nLength := SizeOf(TSECURITYATTRIBUTES);
  472.   Security.lpSecurityDescriptor := nil;
  473.   Security.bInheritHandle := true;
  474.  
  475.   TempSave := CreateFile(PChar('\\.\COM' + IntToStr(ComPort)),
  476.                          GENERIC_READ or GENERIC_WRITE,
  477.                          0,
  478.                          @Security,                             { No Security }
  479.                          OPEN_EXISTING,                     { Creation action }
  480.                          FILE_ATTRIBUTE_NORMAL or FILE_FLAG_OVERLAPPED,
  481.                          0);                                    { No template }
  482.   LastError := GetLastError;
  483.   if LastError <> 0 then
  484.     ErrorStr := 'Unable to open communications port';
  485.  
  486.   SaveHandle := TempSave;
  487.   Result := (TempSave <> INVALID_HANDLE_VALUE);
  488.  
  489.   if Result then             { Make sure that "CharAvail" isn't going to wait }
  490.     begin
  491.       InitDelayTimes;
  492.     end; { if }
  493.  
  494.   if NOT SetupComm(Com_GetHandle, 1024, 1024) then
  495.     begin
  496.       LastError := GetLastError;
  497.  
  498.       { ErrorStr := 'Error setting up communications buffer: #'+IntToStr(LastError) + ' / '+SysErrorMessage(LastError); }
  499.     end; { if }
  500.  
  501.   InitFailed := NOT Com_StartThread;
  502. end; { func. Com_OpenKeep }
  503.  
  504. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  505.  
  506. function TWin32Obj.Com_Open(Comport: Byte; BaudRate: Longint; DataBits: Byte;
  507.                             Parity: Char; StopBits: Byte): Boolean;
  508. begin
  509.   Com_Open := Com_OpenKeep(Comport);
  510.   Com_SetLine(Baudrate, Parity, DataBits, StopBits);
  511. end; { func. TWin32Obj.Com_OpenCom }
  512.  
  513. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  514.  
  515. procedure TWin32Obj.Com_SetLine(BpsRate: longint; Parity: Char; DataBits, Stopbits: Byte);
  516. var DCB   : TDCB;
  517.     BPSID : Longint;
  518. begin
  519.   if BpsRate = 11520 then
  520.     BpsRate := 115200;
  521.  
  522.   GetCommState(Com_GetHandle, DCB);
  523.  
  524.   if NOT (Parity in ['N', 'E', 'O', 'M']) then Parity := 'N';
  525.   if BpsRate >= 0 then dcb.BaudRate := BpsRate;
  526.   dcb.StopBits := ONESTOPBIT;
  527.  
  528.   Case Parity of
  529.     'N' : dcb.Parity := NOPARITY;
  530.     'E' : dcb.Parity := EVENPARITY;
  531.     'O' : dcb.Parity := ODDPARITY;
  532.     'M' : dcb.Parity := MARKPARITY;
  533.   end; { case }
  534.  
  535.   if StopBits = 1 then
  536.     dcb.StopBits := ONESTOPBIT;
  537.   dcb.ByteSize := DataBits;
  538.   dcb.Flags := dcb.Flags OR dcb_Binary or Dcb_DtrControlEnable;
  539.  
  540.   if not SetCommState (Com_GetHandle, DCB) then
  541.     begin
  542.       BPSId := GetLastError;
  543.  
  544.       { ErrorStr := 'Error setting up communications parameters: #'+IntToStr(BpsId) + ' / '+SysErrorMessage(BpsId); }
  545.     end; { if }
  546. end; { proc. TWin32Obj.Com_SetLine }
  547.  
  548. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  549.  
  550. procedure TWin32Obj.Com_Close;
  551. begin
  552.   if DontClose then EXIT;
  553.  
  554.   if Com_GetHandle <> INVALID_HANDLE_VALUE then
  555.     begin
  556.       Com_StopThread;
  557.       CloseHandle(Com_GetHandle);
  558.  
  559.       SaveHandle := INVALID_HANDLE_VALUE;
  560.     end;
  561.  
  562. end; { func. TWin32Obj.Com_CloseCom }
  563.  
  564. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  565.  
  566. function TWin32Obj.Com_SendChar(C: Char): Boolean;
  567. var Written: Longint;
  568. begin
  569.   Com_SendBlock(C, SizeOf(C), Written);
  570.   Com_SendChar := (Written = SizeOf(c));
  571. end; { proc. TWin32Obj.Com_SendChar }
  572.  
  573. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  574.  
  575. function TWin32Obj.Com_GetChar: Char;
  576. var Reads: Longint;
  577. begin
  578.   Com_ReadBlock(Result, SizeOf(Result), Reads);
  579. end; { func. TWin32Obj.Com_GetChar }
  580.  
  581. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  582.  
  583. procedure TWin32Obj.Com_SendBlock(var Block; BlockLen: Longint; var Written: Longint);
  584. begin
  585.   if OutBuffer^.BufRoom < BlockLen then
  586.    repeat
  587.     {$IFDEF WIN32}
  588.       Sleep(1);
  589.     {$ENDIF}
  590.  
  591.     {$IFDEF OS2}
  592.       DosSleep(1);
  593.     {$ENDIF}
  594.    until (OutBuffer^.BufRoom >= BlockLen) OR (NOT Com_Carrier);
  595.  
  596.   CriticalTx^.EnterExclusive;
  597.     Written := OutBuffer^.Put(Block, BlockLen);
  598.   CriticalTx^.LeaveExclusive;
  599.  
  600.   DoTxEvent^.SignalEvent;
  601. end; { proc. TWin32Obj.Com_SendBlock }
  602.  
  603. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  604.  
  605. procedure TWin32Obj.Com_ReadBlock(var Block; BlockLen: Longint; var Reads: Longint);
  606. begin
  607.   if InBuffer^.BufUsed < BlockLen then
  608.     begin
  609.       repeat
  610.         Sleep(1);
  611.       until (InBuffer^.BufUsed >= BlockLen) OR (NOT Com_Carrier);
  612.     end; { if }
  613.  
  614.   CriticalRx^.EnterExclusive;
  615.     Reads := InBuffer^.Get(Block, BlockLen, true);
  616.   CriticalRx^.LeaveExclusive;
  617. end; { proc. TWin32Obj.Com_ReadBlock }
  618.  
  619. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  620.  
  621. function TWin32Obj.Com_CharAvail: Boolean;
  622. begin
  623.   Result := (InBuffer^.BufUsed > 0);
  624. end; { func. TWin32Obj.Com_CharAvail }
  625.  
  626. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  627.  
  628. function TWin32Obj.Com_Carrier: Boolean;
  629. var Status: DWORD;
  630. begin
  631.   GetCommModemStatus(Com_GetHandle,
  632.                      Status);
  633.  
  634.   Result := (Status AND MS_RLSD_ON) <> 00;
  635. end; { func. TWin32Obj.Com_Carrier }
  636.  
  637. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  638.  
  639. procedure TWin32Obj.Com_GetModemStatus(var LineStatus, ModemStatus: Byte);
  640. var Data: DWORD;
  641. begin
  642.   GetCommModemStatus(Com_GetHandle, Data);
  643.  
  644.   ModemStatus := ModemStatus and $0F;
  645.   ModemStatus := ModemStatus or Byte(Data);
  646. end; { proc. TWin32Obj.Com_GetModemStatus }
  647.  
  648. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  649.  
  650. procedure TWin32Obj.Com_SetDtr(State: Boolean);
  651. begin
  652.   if State then
  653.     EscapeCommFunction(Com_GetHandle, SETDTR)
  654.      else EscapeCommFunction(Com_GetHandle, CLRDTR);
  655. end; { proc. TWin32Obj.Com_SetDtr }
  656.  
  657. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  658.  
  659. function TWin32Obj.Com_GetBpsRate: Longint;
  660. var DCB   : TDCB;
  661.     BPSID : Longint;
  662. begin
  663.   GetCommState(Com_GetHandle, DCB);
  664.  
  665.   Com_GetBpsRate := dcb.Baudrate;
  666. end; { func. TWin32Obj.Com_GetBpsRate }
  667.  
  668. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  669.  
  670. procedure TWin32Obj.Com_GetBufferStatus(var InFree, OutFree, InUsed, OutUsed: Longint);
  671. begin
  672.   InFree := InBuffer^.BufRoom;
  673.   OutFree := OutBuffer^.BufRoom;
  674.   InUsed := InBuffer^.BufUsed;
  675.   OutUsed := OutBuffer^.BufUsed;
  676. end; { proc. TWin32Obj.Com_GetBufferStatus }
  677.  
  678. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  679.  
  680. procedure TWin32Obj.Com_PurgeInBuffer;
  681. begin
  682.   CriticalRx^.EnterExclusive;
  683.  
  684.   InBuffer^.Clear;
  685.   PurgeComm(Com_GetHandle, PURGE_RXCLEAR);
  686.  
  687.   CriticalRx^.LeaveExclusive;
  688. end; { proc. TWin32Obj.Com_PurgeInBuffer }
  689.  
  690. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  691.  
  692. procedure TWin32Obj.Com_PurgeOutBuffer;
  693. begin
  694.   CriticalTx^.EnterExclusive;
  695.  
  696.   OutBuffer^.Clear;
  697.   PurgeComm(Com_GetHandle, PURGE_TXCLEAR);
  698.  
  699.   CriticalTx^.LeaveExclusive;
  700. end; { proc. TWin32Obj.Com_PurgeInBuffer }
  701.  
  702. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  703.  
  704. function TWin32Obj.Com_ReadyToSend(BlockLen: Longint): Boolean;
  705. begin
  706.   Result := OutBuffer^.BufRoom >= BlockLen;
  707. end; { func. ReadyToSend }
  708.  
  709. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  710.  
  711. procedure TWin32Obj.Com_PauseCom(CloseCom: Boolean);
  712. begin
  713.   if CloseCom then Com_Close
  714.     else Com_StopThread;
  715. end; { proc. Com_PauseCom }
  716.  
  717. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  718.  
  719. procedure TWin32Obj.Com_ResumeCom(OpenCom: Boolean);
  720. begin
  721.   if OpenCom then
  722.       begin
  723.         if InitPortNr <> -1 then Com_OpenKeep(InitPortNr)
  724.           else Com_OpenQuick(InitHandle);
  725.       end
  726.        else InitFailed := NOT Com_StartThread;
  727. end; { proc. Com_ResumeCom }
  728.  
  729. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  730.  
  731. procedure TWin32Obj.Com_SetFlow(SoftTX, SoftRX, Hard: Boolean);
  732. var DCB   : TDCB;
  733.     BPSID : Longint;
  734. begin
  735.   GetCommState(Com_GetHandle, DCB);
  736.  
  737.   if Hard then
  738.     dcb.Flags := dcb.Flags OR dcb_OutxCtsFlow OR dcb_RtsControlHandshake;
  739.  
  740.   if SoftTX then
  741.     dcb.Flags := dcb.Flags OR dcb_OutX;
  742.  
  743.   if SoftRX then
  744.     dcb.Flags := dcb.Flags OR dcb_InX;
  745.  
  746.   if not SetCommState (Com_GetHandle, DCB) then
  747.     begin
  748.       BPSId := GetLastError;
  749.  
  750.       { ErrorStr := 'Error setting up communications parameters: #'+IntToStr(BpsId) + ' / '+SysErrorMessage(BpsId); }
  751.     end; { if }
  752. end; { proc. Com_SetFlow }
  753.  
  754. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  755.  
  756.  
  757. initialization
  758.   Com_Initvars;
  759.  
  760. finalization
  761.   Com_StopThread;
  762. end. { unit WIN32COM }
  763.