unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Edit1: TEdit;
Button1: TButton;
Memo1: TMemo;
CheckBox1: TCheckBox;
procedure Button1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure CheckBox1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
ComFile: THandle; //Хэндл создаваемого нами файла
ComString: string; //(COM1, COM2 или COM3)
ComSpeed: Integer; //Скорость взаимодействия с COM-портом
Status: Boolean; //подключен или не подключен (чтобы в дальнейшем проверять статус
implementation
{$R *.dfm}
function OpenCOMPort: Boolean;
var DeviceName: array[0..80] of Char;
Device: string;
begin
Device := ComString;
StrPCopy(DeviceName, Device);
ComFile := CreateFile(DeviceName,
GENERIC_READ or GENERIC_WRITE,
0,
nil,
OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL,
0);
if ComFile = INVALID_HANDLE_VALUE then
begin
Result := False;
Status := Result;
end
else
begin
Result := True;
Status := Result;
end;
end;
function SetupCOMPort: Boolean;
const RxBufferSize = 256;
TxBufferSize = 256;
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=' + IntToStr(ComSpeed) + ' parity=n data=8 stop=1'; //Устанавливаем скорость
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 := 1000;
WriteTotalTimeoutMultiplier := 0;
WriteTotalTimeoutConstant := 1000;
end;
if not SetCommTimeouts(ComFile, CommTimeouts) then
Result := False;
end;
procedure Connect;
begin
ComString := 'COM1';
ComSpeed := 19200;
if OpenCOMPort = true then //Открываем порт…
if SetupCOMPort = true then //…и конфигурируем его
Form1.Memo1.Lines.Add('Подключились...');
Sleep(1500); //засыпаем на полторы секунды чтобы дать время на соединение
end;
procedure Disconnect;
begin
CloseHandle(ComFile);
Form1.Memo1.Lines.Add('Отключились.');
end;
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
if CheckBox1.Checked then
Connect
else
Disconnect;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
if Status = true then //При выходе из программы отключаемся
Disconnect;
end;
procedure TForm1.Button1Click(Sender: TObject);
var BytesWritten: DWORD;
s: string;
d: array[1..1500] of Char;
BytesRead: DWORD;
i: Integer;
Result: string;
begin
s := Edit1.Text; //Берём команды из Edit1…
s := s;
WriteFile(ComFile, s[1], Length(s), BytesWritten, nil); //…и посылаем их телефону
Result := '';
if not ReadFile(ComFile, d, SizeOf(d), BytesRead, nil) then
begin
MessageDlg('Ошибка чтения!', mtError, [mbOK], 0);
exit;
end;
s := '';
for i := 1 to BytesRead do //Считываем ответ от телефона
s := s + d[i];
Result := s;
Memo1.Lines.Add(Result); //Выводим ответ от телефона в Memo
end;
end.
|
. 
