hcomport.pas

啊看见电脑哦啊师父破案对方；啊老大你发；dfadsdsfadfd发

procedure THSerialPort.SetupState;
var
 DCB: TDCB;
 Timeouts: TCommTimeouts;
begin
 FillChar(DCB, SizeOf(DCB), 0);

 DCB.DCBlength:=SizeOf(DCB);

 GetCommState(ComHandle, DCB);

 case FBaudRate of
   br110:    DCB.BaudRate:=CBR_110;
   br300:    DCB.BaudRate:=CBR_300;
   br600:    DCB.BaudRate:=CBR_600;
   br1200:   DCB.BaudRate:=CBR_1200;
   br2400:   DCB.BaudRate:=CBR_2400;
   br4800:   DCB.BaudRate:=CBR_4800;
   br9600:   DCB.BaudRate:=CBR_9600;
   br14400:  DCB.BaudRate:=CBR_14400;                
   br19200:  DCB.BaudRate:=CBR_19200;
   br38400:  DCB.BaudRate:=CBR_38400;
   br56000:  DCB.BaudRate:=CBR_56000;
   br57600:  DCB.BaudRate:=CBR_57600;
   br115200: DCB.BaudRate:=CBR_115200;
 end;
 DCB.ByteSize:=FDataBits;
 case FParity of
   prNone:  DCB.Parity:=NOPARITY;
   prOdd:   DCB.Parity:=ODDPARITY;
   prEven:  DCB.Parity:=EVENPARITY;
   prMark:  DCB.Parity:=MARKPARITY;
   prSpace: DCB.Parity:=SPACEPARITY;
 end;
 case FStopBits of
   sbOneStopBit:   DCB.StopBits:=ONESTOPBIT;
   sbOne5StopBits: DCB.StopBits:=ONE5STOPBITS;
   sbTwoStopBits:  DCB.StopBits:=TWOSTOPBITS;
 end;
 DCB.EvtChar:=#0;

 DCB.XonChar:=#17;
 DCB.XoffChar:=#19;
 DCB.XonLim:=0;
 DCB.XoffLim:=0;
 DCB.Flags:=4113; //dcb_Binary or dcb_DtrControl or dcb_RtsControl or dcb_Parity;

{ DCB.XonLim:=FWriteBufSize div 4;
 DCB.XoffLim:=1;

 DCB.Flags:=DCB.Flags or dcb_Binary;
 if FEnableDTR then DCB.Flags:=DCB.Flags or (dcb_DtrControl and (DTR_CONTROL_ENABLE shl 4));

 case FFlowControl of
   fcRtsCts: DCB.Flags:=DCB.Flags or dcb_OutxCtsFlow or (dcb_RtsControl and (RTS_CONTROL_HANDSHAKE shl 12));
   fcXonXoff: DCB.Flags:=DCB.Flags or dcb_OutX or dcb_InX;
   fcBoth: DCB.Flags:=DCB.Flags or dcb_OutX or dcb_InX or dcb_OutxCtsFlow or (dcb_RtsControl and (RTS_CONTROL_HANDSHAKE shl 12));
 end; }
 if not SetCommState(ComHandle,DCB) then DoOnError('Unable to set com state',GetLastError);

 if not GetCommTimeouts(ComHandle,Timeouts) then DoOnError('Unable to set com Timeout',GetLastError);

 timeouts.ReadIntervalTimeout := $FFFFFFFF;
 timeouts.ReadTotalTimeoutMultiplier := CBR_56000;
 case FBaudRate of
   br2400:   timeouts.WriteTotalTimeoutMultiplier := CBR_2400;
   br4800:   timeouts.WriteTotalTimeoutMultiplier := CBR_4800;
   br9600:   timeouts.WriteTotalTimeoutMultiplier := CBR_9600;
   br19200:  timeouts.WriteTotalTimeoutMultiplier := CBR_19200;
   br38400:  timeouts.WriteTotalTimeoutMultiplier := CBR_38400;
   br57600:  timeouts.WriteTotalTimeoutMultiplier := CBR_57600;
   br115200: timeouts.WriteTotalTimeoutMultiplier := CBR_128000;
 end;

 if not SetCommTimeouts(ComHandle, Timeouts) then DoOnError('Unable to set com Timeout',GetLastError);

 EscapeCommFunction(ComHandle,SETDTR);

 if not SetupComm(ComHandle, FReadBufSize, FWriteBufSize) then DoOnError('Unable to set com',GetLastError);
end;

function THSerialPort.InQue: Integer;
var
 Errors: DWORD;
 ComStat: TComStat;
begin
 if not ClearCommError(ComHandle,Errors,@ComStat) then DoOnError('Unable to read com InQue',GetLastError);
 Result:=ComStat.cbInQue;
end;

function THSerialPort.OutQue: Integer;
var
 Errors: DWORD;
 ComStat: TComStat;
begin
 if not ClearCommError(ComHandle,Errors,@ComStat) then DoOnError('Unable to read com OutQue',GetLastError);
 Result:=ComStat.cbOutQue;
end;

function THSerialPort.CheckActiveDCD: Boolean;
var
 dwS: DWORD;
begin
 if not GetCommModemStatus(ComHandle,dwS) then DoOnError('Unable to read com status',GetLastError);
 Result:=(dws and MS_RLSD_ON<>0);
end;

function THSerialPort.ActiveCTS: Boolean;
var
 dwS: DWORD;
begin
 if not GetCommModemStatus(ComHandle,dwS) then DoOnError('Unable to read com status',GetLastError);
 Result:=(dws and MS_CTS_ON<>0);
end;

function THSerialPort.ActiveDSR: Boolean;
var
 dwS: DWORD;
begin
 if not GetCommModemStatus(ComHandle,dwS) then DoOnError('Unable to read com status',GetLastError);
  Result:=(dws and MS_DSR_ON<>0);
end;

function THSerialPort.ActiveRing: Boolean;
var
 dwS: DWORD;
begin
 if not GetCommModemStatus(ComHandle,dwS) then DoOnError('Unable to read com status',GetLastError);
 Result:=(dws and MS_RING_ON<>0);
end;

function THSerialPort.Write(var Buffer; Count: Integer): Integer;
var
 Overlapped: TOverlapped;
 BytesWritten: DWORD;
begin
 FillChar(Overlapped,SizeOf(Overlapped),0);
 Overlapped.hEvent:=CreateEvent(nil,True,True,nil);
 WriteFile(ComHandle,Buffer,Count,BytesWritten,@Overlapped);
 WaitForSingleObject(Overlapped.hEvent, INFINITE);
 if not GetOverlappedResult(ComHandle,Overlapped,BytesWritten,False) then DoOnError('Unable to write to port',GetLastError);
 CloseHandle(Overlapped.hEvent);
 Result:=BytesWritten;
end;

function THSerialPort.WriteString(Str: String): Integer;
begin
 Result:=Write(Str[1],Length(Str));
end;

function THSerialPort.Read(var Buffer; Count: Integer): Integer;
var
 Overlapped: TOverlapped;
 BytesRead: DWORD;
begin
 FillChar(Overlapped,SizeOf(Overlapped),0);
 Overlapped.hEvent:=CreateEvent(nil,True,True,nil);
 ReadFile(ComHandle,Buffer,Count,BytesRead,@Overlapped);
 WaitForSingleObject(Overlapped.hEvent,INFINITE);
 if not GetOverlappedResult(ComHandle,Overlapped,BytesRead,False) then DoOnError('Unable to write to port',GetLastError);
 CloseHandle(Overlapped.hEvent);
 Result:=BytesRead;
end;

function THSerialPort.ReadString(var Str: String; Count: Integer): Integer;
begin
 SetLength(Str,Count);
 Result:=Read(Str[1],Count);
 SetLength(Str,Result);
end;

procedure THSerialPort.PurgeIn;
begin
 if not PurgeComm(ComHandle,PURGE_RXABORT or PURGE_RXCLEAR) then DoOnError('Unable to purge com',GetLastError);
end;

procedure THSerialPort.PurgeOut;
begin
 if not PurgeComm(ComHandle,PURGE_TXABORT or PURGE_TXCLEAR) then DoOnError('Unable to purge com',GetLastError);
end;

function THSerialPort.GetComHandle: THandle;
begin
 Result:=ComHandle;
end;

procedure THSerialPort.SetDataBits(Value: Byte);
begin
 if Value<>FDataBits then
   if Value>8 then FDataBits:=8
   else if Value<5 then FDataBits:=5
   else FDataBits:=Value;
end;

procedure THSerialPort.DoOnRxChar;
begin
 if Assigned(FOnRxChar) then FOnRxChar(Self, InQue);
end;

procedure THSerialPort.DoOnBreak;
begin
 if Assigned(FOnBreak) then FOnBreak(Self);
end;

procedure THSerialPort.DoOnRing;
begin
 if Assigned(FOnRing) then FOnRing(Self);
end;

procedure THSerialPort.DoOnTxEmpty;
begin
 if Assigned(FOnTxEmpty) then FOnTxEmpty(Self);
end;

procedure THSerialPort.DoOnCTS;
begin
 if Assigned(FOnCTS) then FOnCTS(Self);
end;

procedure THSerialPort.DoOnDSR;
begin
 if Assigned(FOnDSR) then FOnDSR(Self);
end;

procedure THSerialPort.DoOnDCD;
begin
 FActiveDCD:=CheckActiveDCD;
 if Assigned(FOnDCD) then FOnDCD(Self);
end;

procedure THSerialPort.DoOnError(Msg : string;Error : integer);
begin
 if Assigned(FOnError) then FOnError(Self,Msg,Error);
 if Error<>0 then EComError.Create(Msg+format('Error Number : %d',[Error]));
end;

procedure THSerialPort.DoOnRxFlag;
begin
 if Assigned(FOnRxFlag) then FOnRxFlag(Self);
end;

function THSerialPort.ComString: String;
begin
 Result:='COM'+IntToStr(Ord(FPortType) + 1);
end;

{procedure THSerialPort.HangUp;
var
 i,itry : integer;
begin
 itry:=0;
 while(connected and ActiveDCD and (itry<3)) do begin
   for i:=0 to 2 do begin
     WriteString('+');
     Sleep(100);
   end;
   Sleep(1200);
   WriteString('a'); Sleep(20);
   WriteString('t'); Sleep(20);
   WriteString('h'); Sleep(20);
   WriteString(#$0d); Sleep(20);
   Sleep(420);
   inc(itry);
 end;
end; }

function THSerialPort.ActiveDCD: Boolean;
begin
 Result:=(FConnected) and (FActiveDCD);
end;

procedure THSerialPort.InitSerialPort;
begin
 SetupState;
 EventThread:=TComThread.Create(Self);
 FConnected:=True;
 FActiveDCD:=CheckActiveDCD;
 if Assigned(FOnOpen) then FOnOpen(Self);
end;

end.