freepascal.ru

Код: Выделить всё

Var
   ComFile: THandle;
function OpenCOMPort: Boolean;
begin
     ComFile := CreateFile(PChar(DeviceName),GENERIC_READ or GENERIC_WRITE,0,nil,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0);
     if ComFile = INVALID_HANDLE_VALUE then
       Result := False
     else
       Result := True;
end;
function SetupCOMPort: Boolean;
const
     RxBufferSize = 1024;
     TxBufferSize = 1024;
var
   DCB: TDCB;
   Config: string;
   CommTimeouts: TCommTimeouts;
begin
     Result:=True;
     if not SetupComm(ComFile, RxBufferSize, TxBufferSize) then
       Result:=False;
     if not GetCommState(ComFile, DCB) then
       Result:=False;
     Config:='baud='+BaudStr+'parity='+ ParityStr+'data='+DataStr+'stop='+StopStr;
     if not BuildCommDCB(@Config[1], DCB) then
       Result := False;
     if not SetCommState(ComFile, DCB) then
       Result := False;
     with CommTimeouts do
     begin
       ReadIntervalTimeout         := 0;
       ReadTotalTimeoutMultiplier  := 0;
       ReadTotalTimeoutConstant    := 350;
       WriteTotalTimeoutMultiplier := 0;
       WriteTotalTimeoutConstant   := 50;
     end;
     if not SetCommTimeouts(ComFile, CommTimeouts) then
       Result := False;
end;
procedure SendText(s: string);
var
   BytesWritten: DWORD;
begin
     WriteFile(ComFile, s[1], Length(s), BytesWritten, nil);
end;
procedure ReadText;
var
   d: array[1..512] of Char;
   BytesRead : DWORD;
   i: integer;
begin
     if not ReadFile(ComFile, d, SizeOf(d), BytesRead, nil) then
     begin
       { Raise an exception }
     end;
     sr := '';
     for i := 1 to BytesRead do
       sr := sr + d[I];
end;


Warheadfromcccp писал(а):мда 59 строк толко чтоб COM включить

Код: Выделить всё

program Test_PComm;

{$APPTYPE CONSOLE}

uses  PComm;

const CSpeed = PComm.B19200;  // скорость
      CTotalTimeOut = 1000;   // таймаут общий (мс)
      CByteTimeOut = 500;     // таймаут между байтами (мс)

var PortsList : set of byte;  // список доступных портов
    PortsCount: integer;      // Количество портов

procedure PortsScan;          // сканирование всех портов
var i, status: integer;
begin
  PortsList:=[ ];
  PortsCount:=0;
  for i:=1 to 255 do begin
    status:= sio_open(i);
    if status=SIO_OK then begin
      sio_close(i);
      PortsList:= PortsList+[ i ];
      Inc(PortsCount);
    end;
  end;
end;

procedure PortsExpo;
var i : integer;
begin
  Write(PortsCount,' found :');
  for i:=1 to 255 do if i in PortsList then Write(i:4);
  Writeln;
end;

function PortOpen(aPort: byte): boolean;
begin
  // Открываем
  Result:= sio_Open(aPort) = SIO_OK;
  if not Result then Exit;
  // Настраиваем скорость, четность, длину, стоп-бит
  Result:= sio_ioctl(aPort, CSpeed, P_NONE or BIT_8 or STOP_1 )=SIO_OK;
  if not Result then Exit;
  // Настраиваем таймаут приема
  Result:= sio_SetReadTimeouts (aPort, CTotalTimeOut, CByteTimeOut)=SIO_OK;
end;

procedure SendString(aPort: byte; const aStr: string);
var i : integer;
begin
  for i:= 1 to Length(aStr) do
    if sio_putch(aPort, Ord(aStr[i])) <> SIO_OK then break;
end;

function RecvString(aPort: byte): string;
var  next: integer;
begin
  Result:='';
  repeat
    next:= sio_getch(aPort);
    if next>0 then Result:= Result + Char(next);
  until next<0;
end;

var Port: integer;
    Request, Answer : string;

begin
  Writeln('Scan com-ports... ');
  PortsScan;
  PortsExpo;
  repeat
    Write('ComPort = '); Readln(Port);
    if Port in PortsList then begin
      if PortOpen(Port) then begin
        Write('Request = '); Readln(Request);
        SendString(Port, Request);
        Answer:= RecvString(Port);
        Writeln('Answer= ', Answer);
      end;
    end;
  until Port=0;
end.


Warheadfromcccp писал(а):тото он ругается на модуль PCOMM Oткрывает окно с текстом программы модуля и предлагает исправлять ошибки

Код: Выделить всё

TBlockSerial.Connect(comport: string);

Код: Выделить всё

function SerOpen(const DeviceName: String): TSerialHandle;

Mr.Smart писал(а):чтож вы хотите то, библиотека 32х разрядная. Используйте 32х разрядный компилятор.

Mr.Smart писал(а):Нафига нужно внешняя библиотека, если есть кросс платформенный модуль synaser?

Код: Выделить всё

procedure TForm1.Button1Click(Sender: TObject);
var
  ser:TBlockSerial;
begin
  ser:=TBlockSerial.Create;
  ser.RaiseExcept:=True;
  try
    // ser.Connect(Edit1.Text, StrToIntDef(Edit2.Text, 9600),8,'N',0,false,false); // было так
    ser.Connect(Edit1.Text);
    ser.Config(StrToIntDef(Edit2.Text, 9600), 8, 'N', SB1, false, false);
    memo1.lines.text:=ser.ATCommand(Edit3.Text);
  finally
    ser.free;
  end;
end;