Показать сообщение отдельно
  #10  
Старый 14.02.2013, 09:27
Аватар для Aristarh Dark
Aristarh Dark Aristarh Dark вне форума
Модератор
 
Регистрация: 07.10.2005
Адрес: Москва
Сообщения: 2,906
Версия Delphi: Delphi XE
Репутация: выкл
По умолчанию

Вообще, как показывает моя практика, асинхронный прием данных из последовательного порта чаще всего не нужен (мне вообще ни разу не понадобился). За время работы с внешними устройствами через последовательный порт я набросал небольшой модуль для работы с портом (открыть/закрыть, чтение/запись, некоторые доп. функции) и успешно им пользуюсь. Работу строю так: в основном цикле потока данные постоянно вычитываются из потра, если что-то приходит - обработка и ответ. Если что-то ножно отправить - сообщение потоку из главной нить приложения о необходимости выполнения определенных действий. Этого вполне хватает. Модуль с функциями для порта ниже.
Код:
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.
__________________
Некоторые программисты настолько ленивы, что сразу пишут рабочий код.

Если вас наказали ни за что - радуйтесь: вы ни в чем не виноваты.
Ответить с цитированием