Вообще, как показывает моя практика, асинхронный прием данных из последовательного порта чаще всего не нужен (мне вообще ни разу не понадобился). За время работы с внешними устройствами через последовательный порт я набросал небольшой модуль для работы с портом (открыть/закрыть, чтение/запись, некоторые доп. функции) и успешно им пользуюсь. Работу строю так: в основном цикле потока данные постоянно вычитываются из потра, если что-то приходит - обработка и ответ. Если что-то ножно отправить - сообщение потоку из главной нить приложения о необходимости выполнения определенных действий. Этого вполне хватает. Модуль с функциями для порта ниже.
Код:
unit COMUtils;
interface
uses
SysUtils, Classes;
function OpenPort(AName: string; BaudRate: integer;
var Handle: THandle): Boolean;
function ClosePort(var AHandle: THandle): Boolean;
function COMRead(AHandle: THandle; Data: PByteArray): Cardinal; overload;
function COMWrite(AHandle: THandle; Data: PByteArray; ALength: Cardinal)
: Cardinal; overload;
function ChangeSpeed(AHandle: THandle; NewSpeed: integer): Boolean;
{$IFDEF VER220} // для delphi xe
function COMRead(AHandle: THandle): RawByteString; overload;
function COMWrite(AHandle: THandle; Data: RawByteString): Cardinal; overload;
{$ELSE}
function COMRead(AHandle: THandle): String; overload;
function COMWrite(AHandle: THandle; Data: string): Cardinal; overload;
{$ENDIF}
procedure GetComList(List: TStrings; ExtendedList:Boolean=False);
implementation
uses
Windows, Registry;
const
bufferlength = 2048;
function DCBSettings(AHandle: THandle; ABaudrate: integer): Boolean;
var
DCB: TDCB;
begin
Result := False;
FillChar(DCB, SizeOf(TDCB), 0);;
if not(GetCommState(AHandle, DCB)) then
Exit;
DCB.Flags := DCB.Flags or (RTS_CONTROL_ENABLE shl 12);
DCB.BaudRate := ABaudrate;
DCB.Parity := NOPARITY;
DCB.ByteSize := 8;
DCB.StopBits := 0;
Result := SetCommState(AHandle, DCB);
end;
function OpenPort(AName: string; BaudRate: integer;
var Handle: THandle): Boolean;
begin
Result := False;
Handle := CreateFile(PChar('\\.\' + AName), GENERIC_READ or GENERIC_WRITE, 0,
nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
if Handle = INVALID_HANDLE_VALUE then
Exit;
if not DCBSettings(Handle, BaudRate) then
Exit;
if not SetupComm(Handle, bufferlength, bufferlength) then
Exit;
if not PurgeComm(Handle, PURGE_TXABORT or PURGE_RXABORT or PURGE_TXCLEAR or
PURGE_RXCLEAR) then
Exit;
EscapeCommFunction(Handle, CLRRTS);
EscapeCommFunction(Handle, CLRDTR);
Result := True;
end;
function ClosePort(var AHandle: THandle): Boolean;
begin
Result := CloseHandle(AHandle);
if Result then
AHandle := INVALID_HANDLE_VALUE;
end;
function COMRead(AHandle: THandle; Data: PByteArray): Cardinal;
var
ComStat: TComStat;
Error: Cardinal;
begin
Result := 0;
if not ClearCommError(AHandle, Error, @ComStat) then
Exit;
if ComStat.cbInQue > 0 then
begin
try
ReadFile(AHandle, Data^[0], ComStat.cbInQue, Result, nil);
except
Result := $FFFFFFFF;
end;
end;
end;
{$IFDEF VER220}
function COMRead(AHandle: THandle): RawByteString;
{$ELSE}
function COMRead(AHandle: THandle): string;
{$ENDIF}
var
Data: TByteArray;
Len: Cardinal;
begin
Result := '';
Len := COMRead(AHandle, @Data);
if Len > 0 then
begin
SetLength(Result, Len);
Move(Data[0], Result[1], Len);
end;
end;
function COMWrite(AHandle: THandle; Data: PByteArray; ALength: Cardinal)
: Cardinal;
begin
try
WriteFile(AHandle, Data^[0], ALength, Result, nil);
except
Result := $FFFFFFFF;
end;
end;
{$IFDEF VER220}
function COMWrite(AHandle: THandle; Data: RawByteString): Cardinal;
{$ELSE}
function COMWrite(AHandle: THandle; Data: String): Cardinal;
{$ENDIF}
begin
Result := COMWrite(AHandle, @Data[1], Length(Data));
end;
function ChangeSpeed(AHandle: THandle; NewSpeed: integer): Boolean;
begin
Result := DCBSettings(AHandle, NewSpeed);
end;
function GetDecimal(Value:string):Integer;
var
decimal:string;
flag:Boolean;
i: Integer;
begin
decimal:='';
flag:=False;
for i := 1 to Length(Value) do
if CharInSet(Value[i],['0'..'9']) then
begin
flag:=true;
decimal:=decimal+Value[i];
end
else
if flag then
Break;
Result:=StrToInt(decimal);
end;
function COMSort(List:TStringList; Index1, Index2:Integer):integer;
var
val1,val2:Integer;
begin
val1:=GetDecimal(List[Index1]);
val2:=GetDecimal(List[Index2]);
if val1=val2 then
Result:=0
else if val1<val2 then
Result:=-1
else
Result:=1;
end;
procedure GetComList(List: TStrings; ExtendedList:Boolean);
var
reg:TRegistry;
sl,sl1:TStringList;
i:integer;
flag:Boolean;
begin
List.Clear;
sl:=TStringList.Create;
sl1:=TStringList.Create;
reg := TRegistry.Create(KEY_READ);
reg.RootKey := HKEY_LOCAL_MACHINE;
reg.OpenKey('hardware\devicemap\serialcomm', false);
reg.GetValueNames(sl);
if sl.Count>0 then
begin
for i := 0 to sl.Count - 1 do
if ExtendedList then
begin
flag:=pos('SILAB',AnsiUpperCase(sl[i]))>0;
if flag then
sl1.AddObject('#'+reg.ReadString(sl[i])+'[CP2102]',pointer(flag))
else
sl1.AddObject(reg.ReadString(sl[i]),pointer(flag));
end
else
begin
sl1.Append(reg.ReadString(sl[i]));
end;
sl1.Sort;
if ExtendedList then
begin
for i := 0 to sl1.Count-1 do
if Boolean(sl1.Objects[i]) then
begin
sl1[i]:=Copy(sl1[i],2,Length(sl1[i])-1);
end;
end;
sl1.CustomSort(COMSort);
List.Text:=sl1.Text;
end;
reg.CloseKey;
reg.free;
sl1.Free;
sl.Free;
end;
end.
__________________
Некоторые программисты настолько ленивы, что сразу пишут рабочий код.
Если вас наказали ни за что - радуйтесь: вы ни в чем не виноваты.
|