|
|
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons, ExtCtrls;
type
TForm1 = class(TForm)
Edit1: TEdit;
Edit2: TEdit;
Label1: TLabel;
Label2: TLabel;
BitBtn1: TBitBtn;
RadioGroup1: TRadioGroup;
RadioGroup2: TRadioGroup;
RadioGroup3: TRadioGroup;
RadioGroup4: TRadioGroup;
RadioGroup5: TRadioGroup;
procedure Edit1Change(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure RadioGroup2Click(Sender: TObject);
procedure RadioGroup3Click(Sender: TObject);
procedure RadioGroup1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
var
baud: DWORD;
byte_size,parity,stop_bits: byte;
TX_Byte: Integer;
input_string: string;
{Переменные описаны как структуры:}
hCom : THANDLE; {Дескриптор открываемого порта}
dcb : TDCB;
ComTo: TCOMMTIMEOUTS;
{Строковые константы}
const
error_text_1: pchar = 'Ошибка при работе с портом !';
error_text_2: pchar = 'Ошибка при передаче данных !';
error_text_3: pchar = 'Ошибка при конфигурировании порта !';
error_caption: pchar = 'Вешайся !!!';
{Функция открывает COM-порт как файл. Строка "S" задает, какой именно
порт нужно открыть}
function OpenCOM(S:pchar):boolean;
begin
{Откроем порт и получим дескриптор}
hCom:= CreateFile(S, {Наименование порта}
GENERIC_READ and GENERIC_WRITE, {Для чтения и для записи}
0, {порт нельзя сделать разделяемым}
nil, {Нет атрибутов безопасности}
OPEN_EXISTING, {Открыть существующий ресурс. Если такого
ресурса нет, функция вернет ошибку}
FILE_FLAG_OVERLAPPED,
0); {описатель файла - шаблона}
{Проанализируем полученный дескриптор}
if hCom=INVALID_HANDLE_VALUE then begin
Result:=false;
exit;
end;
{Прочитать текущие настройки порта в DCB-структуру. Если была ошибка,фун-
кция возвращает FALSE}
if GetCommState(hCom,dcb) = false
then begin Result:=false; exit; end;
{Прочитать временные параметры порта (CommTimeOuts).Если была ошибка,фун-
кция возвращает FALSE}
if GetCommTimeouts(hCom,ComTo) = false
then begin Result:=false; exit; end;
// ComP.dwProvSpec1:=COMMPROP_INITIALIZED;
// if not GetCommProperties(hCom,ComP)
// then begin Result:=false; exit; end;
Result:=true;
end;
{Функция закрывает открытый COM-порт}
function CloseCOM:boolean;
begin
Result:=CloseHandle(hCom);
end;
{Функция устанавливает указанные при вызове параметры порта}
function SetCOM(baud:DWORD;bsize,parity,sbits:BYTE):boolean;
begin
dcb.BaudRate:=baud;
dcb.Flags:=$00000001; //DTR $00000010 RTS $00001000
dcb.ByteSize:=bsize;
dcb.Parity:=parity;
dcb.StopBits:=sbits;
if not SetCommState(hCom,dcb)
then begin Result:=false; exit; end;
// if not SetupComm(hCom,1,1)
// then begin Result:=false; exit; end;
{Установить временные параметры порта}
ComTo.ReadIntervalTimeout:=MAXDWORD;
ComTo.ReadTotalTimeoutMultiplier:=0;
ComTo.ReadTotalTimeoutConstant:=0;
ComTo.WriteTotalTimeoutMultiplier:=0;
ComTo.WriteTotalTimeoutConstant:=0;
if not SetCommTimeouts(hCom,ComTo)
then begin Result:=false; exit; end;
Result:=true;
end;
function Set_DTR(b:boolean):boolean;
begin
if b
then Result:=EscapeCommFunction(hCom,SETDTR)
else Result:=EscapeCommFunction(hCom,CLRDTR);
end;
function Set_RTS(b:boolean):boolean;
begin
if b
then Result:=EscapeCommFunction(hCom,SETRTS)
else Result:=EscapeCommFunction(hCom,CLRRTS);
end;
function TXDCOM(data:char):boolean;
begin
Result:=TransmitCommChar(hCom,data);
end;
function SetEventsCOM:boolean;
begin
{Сорбытие - символ принят и помещен в буфер}
Result:=SetCommMask(hCom, EV_RXCHAR);
end;
function ClrCOM:boolean;
begin
Result:=PurgeComm(hCom,PURGE_TXABORT or
PURGE_RXABORT or
PURGE_TXCLEAR or
PURGE_RXCLEAR);
end;
procedure TForm1.Edit1Change(Sender: TObject);
begin
if edit1.text='' then exit;
input_string:=edit1.text;
if txdcom (input_string[length(input_string)])=false
then begin MessageBox (0,error_text_2, error_caption, MB_OK);
exit;
end
else exit;
end;
procedure TForm1.FormActivate(Sender: TObject);
begin
edit1.setfocus;
{По умолчанию скорость равна 9600, битов данных - восемь, бит четности не ис-
пользуется и будет передаваться только один стоп - бит}
{ radiogroup1.onclick:=false;}
radiogroup1.itemindex:=4;
radiogroup2.itemindex:=2;
radiogroup3.itemindex:=0;
radiogroup4.itemindex:=0;
radiogroup5.itemindex:=1;
baud:=CBR_9600;
byte_size:=8;
parity:=0;
stop_bits:=0;
if OpenCom('COM1')=FALSE then begin
MessageBox (0,error_text_1, error_caption, MB_OK);
exit;
end;
if SetCom(baud,byte_size,parity,stop_bits)=false then begin
MessageBox (0,error_text_3, error_caption, MB_OK);
exit;
end;
clrcom;
end;
procedure TForm1.RadioGroup2Click(Sender: TObject);
begin
{Прочитать текущие настройки порта в DCB-структуру. Если была ошибка,фун-
кция возвращает FALSE}
if not GetCommState(hCom,dcb)
then begin MessageBox (0,error_text_3, error_caption, MB_OK);
exit;
end;
if radiogroup2.itemindex=0 then byte_size:=6;
if radiogroup2.itemindex=1 then byte_size:=7;
if radiogroup2.itemindex=2 then byte_size:=8;
if SetCom(baud,byte_size,parity,stop_bits)=false then begin
MessageBox (0,error_text_3, error_caption, MB_OK);
exit;
end;
end;
procedure TForm1.RadioGroup3Click(Sender: TObject);
begin
{Прочитать текущие настройки порта в DCB-структуру. Если была ошибка,фун-
кция возвращает FALSE}
if GetCommState(hCom,dcb) = false
then begin MessageBox (0,error_text_3, error_caption, MB_OK);
exit;
end;
if radiogroup3.itemindex=0 then stop_bits:=0;
if radiogroup3.itemindex=1 then stop_bits:=1;
if radiogroup3.itemindex=2 then stop_bits:=2;
if SetCom(baud,byte_size,parity,stop_bits)=false then begin
MessageBox (0,error_text_3, error_caption, MB_OK);
exit;
end;
end;
procedure TForm1.RadioGroup1Click(Sender: TObject);
begin
{Прочитать текущие настройки порта в DCB-структуру. Если была ошибка,фун-
кция возвращает FALSE}
if not GetCommState(hCom,dcb)
then begin MessageBox (0,error_text_3, error_caption, MB_OK);
exit;
end;
if radiogroup1.itemindex=0 then baud:=CBR_115200;
if radiogroup1.itemindex=1 then baud:=CBR_57600;
if radiogroup1.itemindex=2 then baud:=CBR_38400;
if radiogroup1.itemindex=3 then baud:=CBR_19200;
if radiogroup1.itemindex=4 then baud:=CBR_9600;
if radiogroup1.itemindex=5 then baud:=CBR_4800;
if radiogroup1.itemindex=6 then baud:=CBR_2400;
if radiogroup1.itemindex=7 then baud:=CBR_1200;
if SetCom(baud,byte_size,parity,stop_bits)=false then begin
MessageBox (0,error_text_3, error_caption, MB_OK);
exit;
end;
end;
end.
E-mail: 
info@telesys.ru
