|
|
|
Obsługa portu COM
|
|
|
|
W większości przypadków do obsługi portu COM nie jest potrzebne instalowanie dodatkowych komponentów.
Oto jak za pomocą kilku funkcji WinAPI obsłużyć transmisję przez port COM.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure FormCreate(Sender: TObject);
private
hPort: THandle;
procedure SendAndReceive;
public
procedure ClosePort;
function GetInCount: LongInt;
function OpenPort: boolean;
procedure ToggleControlLines;
function GetLineStatus(Status: DWORD): boolean;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
//-----------------------------------------------------------
procedure TForm1.FormCreate(Sender: TObject);
begin
hPort := INVALID_HANDLE_VALUE
end;
//-----------------------------------------------------------
function TForm1.OpenPort: boolean;
var
dcbPort:TDCB;
tout: TCommTimeouts;
begin
result := true;
if hPort <> INVALID_HANDLE_VALUE then
ClosePort;
if hPort = INVALID_HANDLE_VALUE then
begin
result := False;
hPort := CreateFile( '\\.\COM1',
GENERIC_READ or GENERIC_WRITE,
0, nil,
OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL,
LongInt(0));
if hPort <> INVALID_HANDLE_VALUE then
begin
if GetCommState(hPort, dcbPort) then
begin
// set port parameters
dcbPort.BaudRate := 9600;
dcbPort.ByteSize := 8;
dcbPort.Parity := 0; // no parity
dcbPort.StopBits := 0; // 1 stop bit
dcbPort.Flags := 0;
SetCommState(hPort, dcbPort);
// set port timeouts
GetCommTimeouts(hPort,tout);
tout.ReadTotalTimeoutMultiplier := 30;
tout.ReadTotalTimeoutConstant := 50;
tout.ReadIntervalTimeout := 50;
SetCommTimeouts(hPort,tout);
// set port buffers lengths
SetupComm(hPort,6000,2000);
result := true;
end;
end;
end
end;
//-----------------------------------------------------------
procedure TForm1.ClosePort;
begin
if hPort <> INVALID_HANDLE_VALUE then
begin
if CloseHandle(hPort) then
begin
hPort := INVALID_HANDLE_VALUE;
end;
end;
end;
//-----------------------------------------------------------
function TForm1.GetInCount: LongInt;
var
statPort: TCOMSTAT;
dwErrorCode: DWord;
begin
Result := 0;
if hPort <> INVALID_HANDLE_VALUE then
begin
ClearCommError(hPort, dwErrorCode, @statPort);
Result := statPort.cbInQue; // count bytes in input buffor
end;
end;
//-----------------------------------------------------------
procedure TForm1.ToggleControlLines;
begin
if hPort <> INVALID_HANDLE_VALUE then
begin
EscapeCommFunction(hPort, CLRDTR);
EscapeCommFunction(hPort, CLRRTS);
EscapeCommFunction(hPort, SETDTR);
EscapeCommFunction(hPort, SETRTS);
EscapeCommFunction(hPort, CLRDTR);
EscapeCommFunction(hPort, CLRRTS);
end;
end;
//-----------------------------------------------------------
//Value Meaning
// MS_CTS_ON The CTS (clear-to-send) signal is on.
// MS_DSR_ON The DSR (data-set-ready) signal is on.
// MS_RING_ON The ring indicator signal is on.
// MS_RLSD_ON The RLSD (receive-line-signal-detect) signal is on.
//-----------------------------------------------------------
function TForm1.GetLineStatus(Status: DWORD): boolean;
begin
Result := False;
if hPort <> INVALID_HANDLE_VALUE then
begin
GetCommModemStatus(hPort,Status);
Result := True;
end;
end;
//-----------------------------------------------------------
procedure TForm1.SendAndReceive;
var
buf: string;
nReceived: DWord;
nSent: DWord;
sec: integer;
begin
if hPort = INVALID_HANDLE_VALUE then
exit;
// clear input buffer
PurgeComm(hPort,PURGE_RXCLEAR);
// Send some one byte command to external imaginary device
buf := 'r';
WriteFile(hPort,PChar(buf)^,1,nSent,nil);
// receive device response - 5 bytes long
SetLength( buf, 5 );
ReadFile(hPort, PChar(buf)^, 5, nReceived, nil);
if nReceived = 5 then
begin
SetLength( buf, nReceived );
// you can do some operations with received response
// ...
end;
end;
end.
|
|
|
|
| Promocje | Darmowe ogłoszenia korepetycji http://superkorki.net
| | | Wiadomości | 07 lip 2018
Udostępniona została strona z generatorami danych testowych PESEL, NIP, REGON, IBAN, Numer dowodu osobistego http://gen.abak.waw.pl
11 gru 2017
Udostępniona została strona z wyszukiwarką słów do krzyżówek http://krzyzowka.abak.waw.pl
20 wrz 2016
Udostępniona została biblioteka procedur C do obsługi zewnętrznej pamięci flash dla procesorów z rodziny MSP430 http://abak.waw.pl/flashlib
12 lis 2010
Uruchomiony został serwis ogłoszeń korepetycji http://superkorki.net Codziennie przybywają nowe ogłoszenia. Warto zajrzeć i skorzystać. Interesującym dodatkiem jest zestaw wzorów matematycznych fizycznych i chemicznych dla gimnazjum i liceum
22-25 mar 2007
- Zapraszam na zawody hipiczne na Torwarze.
Ładne widowisko. Wyświetlamy pomiar czasu na telebimie.
02 lis 2004
- Podpisanie umowy o współpracy z monowise GmbH w zakresie opracowywania oprogramowania obsługującego kamery sieciowe. Zliczanie osób, rejestracja video dla potrzeb ochrony.
10 sie 2003
- Inaugracyjne zawody z dużą tablicą informacyjną na stadionie RKM Rybnik.
| |
|
|
