eğer hyperterminal düzgün okuyorsa donanımsal bir sonunuz yok demektir.
ilk olarak giriş çıkış bufferlarını temizle her okumada.
PurgeComm(FHandle, PURGE_RXABORT+PURGE_RXCLEAR);
PurgeComm(FHandle, PURGE_TXABORT+PURGE_TXCLEAR);
hyperterminal her read etmesinde buffer ın uzunluğukadar okur ekrana yansıtır.
sizin için en iyi okuma okunacak karakter sayısını belirtmektir.böylece stabil bir okuma elde etmiş olursunuz
örnek verilecek olunursa kendi unitim üzerinden vereyim.ha bu arada component kullanmayın.
unitte bulunan readstring function'u bufferused kadar okuma yapar bunu biraz değiştirirseniz bir count ve time out süresi ile düzenli bir
çalışma elde etmiş olursunuz.
Kod: Tümünü seç
function TSerialConnection.ReadString2(const Count: integer;
const TimeOut: cardinal): string;
var
T: cardinal;
begin
Result := '';
if Count = 0 then Exit;
T := GetTickCount;
repeat
if InBufUsed >= Count then
begin
Result := ReadString(Count);
Exit;
end;
if GetTickCount - T > TimeOut then
Exit;
Sleep(10);
until False;
end;
kullanımı için uniti ekleyin bir variable tanımlayın.
FConnection: TSerialConnection;
daha sonra create edin
FConnection := TSerialConnection.Create(nil);
baud + parity + bit sayısı falan filan ayarlayın connect edin.
sonrada okuyun kafanıza göre....
Kod: Tümünü seç
unit CPD;
interface
uses
Windows, SysUtils, Classes;
type
{ TSerialConnection }
TComPort = (cpCOM1, cpCOM2, cpCOM3, cpCOM4, cpCOM5, cpCOM6);
TBaudRate = (br110, br300, br600, br1200, br2400, br4800,
br9600, br14400, br19200, br38400, br56000,
br57600, br115200);
TDataBits = (db5BITS, db6BITS, db7BITS, db8BITS);
TStopBits = (sb1BITS, sb1HALFBITS, sb2BITS);
TParity = (ptNONE, ptODD, ptEVEN, ptMARK, ptSPACE);
THwHandshaking = (hhNONE, hhRTSCTS);
TSwHandshaking = (shNONE, shXONXOFF);
TReadWriteEvent = procedure(Sender: TObject; const Data: string) of object;
TSerialConnection = class(TComponent)
private
FHandle: THandle;
FComPort: TComPort;
FBaudRate: TBaudRate;
FDataBits: TDataBits;
FStopBits: TStopBits;
FComPortParity: TParity;
FHwHandshaking: THwHandshaking;
FSwHandshaking: TSwHandshaking;
FInBufSize: integer;
FOutBufSize: integer;
FReadIntervalTimeout: cardinal;
FReadTotalTimeoutMultiplier: cardinal;
FReadTotalTimeoutConstant: cardinal;
FWriteTotalTimeoutMultiplier: cardinal;
FWriteTotalTimeoutConstant: cardinal;
FOnWrite: TReadWriteEvent;
FOnRead: TReadWriteEvent;
procedure SetComPort(const Value: TComPort);
procedure SetBaudRate(const Value: TBaudRate);
procedure SetDataBits(const Value: TDataBits);
procedure SetStopBits(const Value: TStopBits);
procedure SetParity(const Value: TParity);
procedure SetHwHandshaking(const Value: THwHandshaking);
procedure SetSwHandshaking(const Value: TSwHandshaking);
procedure SetReadIntervalTimeout(const Value: cardinal);
procedure SetReadTotalTimeoutMultiplier(const Value: cardinal);
procedure SetReadTotalTimeoutConstant(const Value: cardinal);
procedure SetWriteTotalTimeoutMultiplier(const Value: cardinal);
procedure SetWriteTotalTimeoutConstant(const Value: cardinal);
procedure SetInBufSize(const Value:integer);
procedure SetOutBufSize(const Value:integer);
procedure ApplySettings;
function GetComStat: TComStat;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Connect;
procedure Disconnect;
function Connected: boolean;
procedure WriteString(const S: string);
function ReadString(Count: cardinal = 0): string;
function ReadString2(const Count: integer; const TimeOut: cardinal): string;
function InBufUsed: cardinal;
function OutBufUsed: cardinal;
procedure PurgeInBuf;
procedure PurgeOutBuf;
function RTSHigh: boolean;
function RTSLow: boolean;
function DTRHigh: boolean;
function DTRLow: boolean;
procedure SetBreakState(const Value: boolean);
procedure Assign(Source: TPersistent); override;
property Handle: THandle read FHandle;
published
property ComPort: TComPort read FComPort write SetComPort default cpCOM2;
property Speed: TBaudRate read FBaudRate write SetBaudRate default br9600;
property DataBits: TDataBits read FDataBits write SetDataBits default db8BITS;
property StopBits: TStopBits read FStopBits write SetStopBits default sb1BITS;
property Parity: TParity read FComPortParity write SetParity default ptNONE;
property HwHandshaking: THwHandshaking read FHwHandshaking write SetHwHandshaking default hhNONE;
property SwHandshaking: TSwHandshaking read FSwHandshaking write SetSwHandshaking default shNONE;
property InBufSize: integer read FInBufSize write SetInBufSize default 2048;
property OutBufSize: integer read FOutBufSize write SetOutBufSize default 2048;
property ReadIntervalTimeout: cardinal read FReadIntervalTimeout write SetReadIntervalTimeout;
property ReadTotalTimeoutMultiplier: cardinal read FReadTotalTimeoutMultiplier write SetReadTotalTimeoutMultiplier;
property ReadTotalTimeoutConstant: cardinal read FReadTotalTimeoutConstant write SetReadTotalTimeoutConstant;
property WriteTotalTimeoutMultiplier: cardinal read FWriteTotalTimeoutMultiplier write SetWriteTotalTimeoutMultiplier;
property WriteTotalTimeoutConstant: cardinal read FWriteTotalTimeoutConstant write SetWriteTotalTimeoutConstant;
property OnRead: TReadWriteEvent read FOnRead write FOnRead;
property OnWrite: TReadWriteEvent read FOnWrite write FOnWrite;
end;
implementation
procedure SCError;
begin
raise Exception.Create('Serial Connection Error!'+#13#10+SysErrorMessage(GetLastError));
end;
{ TSerialConnection }
constructor TSerialConnection.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FHandle := INVALID_HANDLE_VALUE;
FComPort := cpCOM1;
FBaudRate := br9600;
FDataBits := db8BITS;
FStopBits := sb1BITS;
FComPortParity := ptNONE;
FHwHandshaking := hhNONE;
FSwHandshaking := shNONE;
FInBufSize := 2048;
FOutBufSize := 2048;
FReadIntervalTimeout := MAXDWORD;
FReadTotalTimeoutMultiplier := 0;
FReadTotalTimeoutConstant := 0;
FWriteTotalTimeoutMultiplier := 0;
FWriteTotalTimeoutConstant := 0;
end;
destructor TSerialConnection.Destroy;
begin
if Connected then Disconnect;
inherited Destroy;
end;
procedure TSerialConnection.Assign(Source: TPersistent);
begin
if Source is TSerialConnection then
begin
ComPort := TSerialConnection(Source).ComPort;
Speed := TSerialConnection(Source).Speed;
DataBits := TSerialConnection(Source).DataBits;
StopBits := TSerialConnection(Source).StopBits;
Parity := TSerialConnection(Source).Parity;
HwHandshaking := TSerialConnection(Source).HwHandshaking;
SwHandshaking := TSerialConnection(Source).SwHandshaking;
InBufSize := TSerialConnection(Source).InBufSize;
OutBufSize := TSerialConnection(Source).OutBufSize;
ReadIntervalTimeout := TSerialConnection(Source).ReadIntervalTimeout;
ReadTotalTimeoutMultiplier := TSerialConnection(Source).ReadTotalTimeoutMultiplier;
ReadTotalTimeoutConstant := TSerialConnection(Source).ReadTotalTimeoutConstant;
WriteTotalTimeoutMultiplier := TSerialConnection(Source).WriteTotalTimeoutMultiplier;
WriteTotalTimeoutConstant := TSerialConnection(Source).WriteTotalTimeoutConstant;
end
else inherited Assign(Source);
end;
procedure TSerialConnection.PurgeInBuf;
begin
if not PurgeComm(FHandle, PURGE_RXABORT+PURGE_RXCLEAR) then SCError;
end;
procedure TSerialConnection.PurgeOutBuf;
begin
if not PurgeComm(FHandle, PURGE_TXABORT+PURGE_TXCLEAR) then SCError;
end;
procedure TSerialConnection.SetComPort(const Value: TComPort);
begin
if Value <> FComPort then
begin
if Connected then Disconnect;
FComPort := Value;
end;
end;
procedure TSerialConnection.SetBaudRate(const Value: TBaudRate);
begin
FBaudRate := Value;
if Connected then ApplySettings;
end;
procedure TSerialConnection.SetDataBits(const Value: TDataBits);
begin
FDataBits := Value;
if Connected then ApplySettings;
end;
procedure TSerialConnection.SetStopBits(const Value: TStopBits);
begin
FStopBits := Value;
if Connected then ApplySettings;
end;
procedure TSerialConnection.SetParity(const Value: TParity);
begin
FComPortParity := Value;
if Connected then ApplySettings;
end;
procedure TSerialConnection.SetHwHandshaking(const Value: THwHandshaking);
begin
FHwHandshaking := Value;
if Connected then ApplySettings;
end;
procedure TSerialConnection.SetInBufSize(const Value:integer);
begin
FInBufSize := Value;
if Connected then ApplySettings;
end;
procedure TSerialConnection.SetOutBufSize(const Value:integer);
begin
FOutBufSize := Value;
if Connected then ApplySettings;
end;
procedure TSerialConnection.SetSwHandshaking(const Value: TSwHandshaking);
begin
FSwHandshaking := Value;
if Connected then ApplySettings;
end;
procedure TSerialConnection.SetReadIntervalTimeout(const Value: cardinal);
begin
FReadIntervalTimeout := Value;
if Connected then ApplySettings;
end;
procedure TSerialConnection.SetReadTotalTimeoutMultiplier(const Value: cardinal);
begin
FReadTotalTimeoutMultiplier := Value;
if Connected then ApplySettings;
end;
procedure TSerialConnection.SetReadTotalTimeoutConstant(const Value: cardinal);
begin
FReadTotalTimeoutConstant := Value;
if Connected then ApplySettings;
end;
procedure TSerialConnection.SetWriteTotalTimeoutMultiplier(const Value: cardinal);
begin
FWriteTotalTimeoutMultiplier := Value;
if Connected then ApplySettings;
end;
procedure TSerialConnection.SetWriteTotalTimeoutConstant(const Value: cardinal);
begin
FWriteTotalTimeoutConstant := Value;
if Connected then ApplySettings;
end;
procedure TSerialConnection.ApplySettings;
const
Win32BaudRates: array[br110..br115200] of DWORD =
(CBR_110, CBR_300, CBR_600, CBR_1200, CBR_2400, CBR_4800, CBR_9600,
CBR_14400, CBR_19200, CBR_38400, CBR_56000, CBR_57600, CBR_115200);
DCB_Binary = $00000001;
DCB_ParityCheck = $00000002;
DCB_OutxCtsFlow = $00000004;
DCB_OutxDsrFlow = $00000008;
DCB_DtrControlMask = $00000030;
DCB_DtrControlDisable = $00000000;
DCB_DtrControlEnable = $00000010;
DCB_DtrControlHandshake = $00000020;
DCB_DsrSensivity = $00000040;
DCB_TXContinueOnXoff = $00000080;
DCB_OutX = $00000100;
DCB_InX = $00000200;
DCB_ErrorChar = $00000400;
DCB_NullStrip = $00000800;
DCB_RtsControlMask = $00003000;
DCB_RtsControlDisable = $00000000;
DCB_RtsControlEnable = $00001000;
DCB_RtsControlHandshake = $00002000;
DCB_RtsControlToggle = $00003000;
DCB_AbortOnError = $00004000;
DCB_Reserveds = $FFFF8000;
var
DCB: TDCB;
TMS: TCOMMTIMEOUTS;
begin
if not Connected then Exit;
FillChar(DCB, SizeOf(DCB), 0);
DCB.DCBLength := SizeOf(DCB);
DCB.BaudRate := Win32BaudRates[FBaudRate];
DCB.Flags := DCB_Binary or DCB_DtrControlEnable;
case FHwHandshaking of
hhNONE : ;
hhRTSCTS : DCB.Flags := DCB.Flags or DCB_OutxCtsFlow or DCB_RtsControlHandshake;
end;
case FSwHandshaking of
shNONE : ;
shXONXOFF : DCB.Flags := DCB.Flags or DCB_OutX or DCB_InX;
end;
DCB.XONLim := FInBufSize div 4;
DCB.XOFFLim := 1;
DCB.ByteSize := 5 + Ord(FDataBits);
DCB.Parity := Ord(FComPortParity);
DCB.StopBits := Ord(FStopBits);
DCB.XONChar := #17;
DCB.XOFFChar := #19;
SetCommState(FHandle, DCB);
SetupComm(FHandle, FInBufSize, FOutBufSize);
FillChar(TMS, SizeOf(TMS), 0);
TMS.ReadIntervalTimeout := FReadIntervalTimeout;
TMS.ReadTotalTimeoutMultiplier := FReadTotalTimeoutMultiplier;
TMS.ReadTotalTimeoutConstant := FReadTotalTimeoutConstant;
TMS.WriteTotalTimeoutMultiplier := FWriteTotalTimeoutMultiplier;
TMS.WriteTotalTimeoutConstant := FWriteTotalTimeoutConstant;
SetCommTimeOuts(FHandle, TMS);
end;
procedure TSerialConnection.Connect;
var
ComName: array[0..4] of Char;
begin
if Connected then Exit;
StrPCopy(ComName, 'COM');
ComName[3] := Chr(Ord('1') + Ord(FComPort));
ComName[4] := #0;
FHandle := CreateFile(ComName,
GENERIC_READ or GENERIC_WRITE,
0,
nil,
OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL,
0) ;
if not Connected then SCError;
ApplySettings;
end;
procedure TSerialConnection.Disconnect;
begin
CloseHandle(FHandle);
FHandle := INVALID_HANDLE_VALUE;
end;
function TSerialConnection.Connected: boolean;
begin
Result := FHandle <> INVALID_HANDLE_VALUE;
end;
procedure TSerialConnection.WriteString(const S: string);
var
BytesTransferred: cardinal;
begin
if not WriteFile(FHandle, S[1], Length(S), BytesTransferred, nil) then SCError;
if Assigned(FOnWrite) then
FOnWrite(Self, S);
end;
function TSerialConnection.ReadString(Count: cardinal = 0): string;
var
BytesTransferred: cardinal;
begin
if Count = 0 then
Count := InBufUsed;
SetLength(Result, Count);
if not ReadFile(FHandle, Result[1], Length(Result), BytesTransferred, nil) then SCError;
SetLength(Result, BytesTransferred);
if Assigned(FOnRead) then
FOnRead(Self, Result);
end;
function TSerialConnection.GetComStat: TComStat;
var
ComStat : TComStat;
Errors : cardinal;
begin
if not ClearCommError(FHandle, Errors, @ComStat) then SCError;
Result := ComStat;
end;
function TSerialConnection.InBufUsed: cardinal;
begin
Result := GetComStat.cbInQue;
end;
function TSerialConnection.OutBufUsed: cardinal;
begin
Result := GetComStat.cbOutQue;
end;
function TSerialConnection.RTSHigh: boolean;
begin
Result := EscapeCommFunction(FHandle, SETRTS);
end;
function TSerialConnection.RTSLow: boolean;
begin
Result := EscapeCommFunction(FHandle, CLRRTS);
end;
function TSerialConnection.DTRHigh: boolean;
begin
Result := EscapeCommFunction(FHandle, SETDTR);
end;
function TSerialConnection.DTRLow: boolean;
begin
Result := EscapeCommFunction(FHandle, CLRDTR);
end;
procedure TSerialConnection.SetBreakState(const Value: boolean);
begin
if Value then
begin
if not SetCommBreak(FHandle) then SCError;
end
else
begin
if not ClearCommBreak(FHandle) then SCError;
end;
end;
function TSerialConnection.ReadString2(const Count: integer;
const TimeOut: cardinal): string;
var
T: cardinal;
begin
Result := '';
if Count = 0 then Exit;
T := GetTickCount;
repeat
if InBufUsed >= Count then
begin
Result := ReadString(Count);
Exit;
end;
if GetTickCount - T > TimeOut then
Exit;
Sleep(10);
until False;
end;
end.
Kolay gelsin...
