unit
Main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Registry,ReadThread;
type
TMainForm =
class
(TForm)
OpenPort: TButton;
ClosePort: TButton;
SendData: TButton;
ReadData: TButton;
PortStateLabel: TLabel;
Label1: TLabel;
Label2: TLabel;
nToReadLabel: TLabel;
nReadLabel: TLabel;
Label3: TLabel;
RcDataLabel: TLabel;
Label4: TLabel;
Label5: TLabel;
bRefreshComPrt: TButton;
cbCOMPrts: TComboBox;
cbSpeed: TComboBox;
procedure
OpenPortClick(Sender: TObject);
procedure
ClosePortClick(Sender: TObject);
procedure
SendDataClick(Sender: TObject);
procedure
ReadDataClick(Sender: TObject);
procedure
FormCreate(Sender: TObject);
procedure
FormClose(Sender: TObject;
var
Action: TCloseAction);
procedure
bRefreshComPrtClick(Sender: TObject);
procedure
RefreshComPrt;
procedure
FormShow(Sender: TObject);
private
public
Port:THandle;
end
;
var
MainForm: TMainForm;
ReadThr:TReadThread;
implementation
{$R *.dfm}
procedure
TMainForm
.
OpenPortClick(Sender: TObject);
Var
DCB:TDCB;
CommTimeouts:TCommTimeouts;
begin
Port:=CreateFile(
pWideChar
(cbCOMPrts
.
Text),
GENERIC_READ
or
GENERIC_WRITE,
0
,
nil
,
OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL,
0
);
if
(port=INVALID_HANDLE_VALUE)
then
showmessage(
'Ошибочка вышла!'
)
else
POrtStateLabel
.
Caption:=
'Порт открыт'
;
GetCommState(port, DCB);
DCB
.
BaudRate:=StrToInt(cbSpeed
.
Text);
DCB
.
Parity:=NoParity;
DCB
.
ByteSize:=
8
;
DCB
.
StopBits:=ONESTOPBIT;
SetCommState(port, DCB);
GetCommTimeouts(Port, CommTimeouts);
CommTimeouts
.
ReadIntervalTimeout :=MAXDWORD;
CommTimeouts
.
ReadTotalTimeoutMultiplier :=
0
;
CommTimeouts
.
ReadTotalTimeoutConstant :=
0
;
CommTimeouts
.
WriteTotalTimeoutMultiplier :=
0
;
CommTimeouts
.
WriteTotalTimeoutConstant :=
0
;
SetCommTimeouts(Port, CommTimeouts);
end
;
procedure
TMainForm
.
RefreshComPrt;
var
reg : TRegistry;
ts : TStrings;
i :
integer
;
begin
cbCOMPrts
.
Items
.
Clear;
reg := TRegistry
.
Create;
reg
.
RootKey := HKEY_LOCAL_MACHINE;
reg
.
OpenKey(
'hardware\devicemap\serialcomm'
,
false
);
ts := TStringList
.
Create;
reg
.
GetValueNames(ts);
for
i :=
0
to
ts
.
Count -
1
do
begin
cbCOMPrts
.
Items
.
Add(reg
.
ReadString(ts
.
Strings[i]));
end
;
if
cbCOMPrts
.
Items
.
Count>
0
then
cbCOMPrts
.
ItemIndex:=
0
;
ts
.
Free;
reg
.
CloseKey;
reg
.
free;
end
;
procedure
TMainForm
.
bRefreshComPrtClick(Sender: TObject);
begin
RefreshComPrt;
end
;
procedure
TMainForm
.
ClosePortClick(Sender: TObject);
begin
if
not
CloseHandle(Port)
then
showmessage(
'Не закрылось'
)
else
PortStateLabel
.
Caption:=
'Порт не открыт'
end
;
procedure
TMainForm
.
SendDataClick(Sender: TObject);
var
TRBuf:
PChar
;
nToWrite:DWord;
nWrite:DWord;
begin
TRBuf:=
'1'
;
nToWrite:=length(TRBuf)+
1
;
WriteFile(port,TRBuf^,nToWrite,nWrite,
nil
);
end
;
procedure
TMainForm
.
ReadDataClick(Sender: TObject);
Var
RCBuf:
PChar
;
nToRead:
Cardinal
;
ReadedBytes:
integer
;
nRead:
Cardinal
;
ComStat:TComStat;
Errs:Dword;
Data:TStringList;
begin
ReadedBytes:=
0
;
Data:=TStringList
.
Create;
ClearCommError(POrt,Errs,@ComStat);
nToRead:=ComStat
.
cbInQue;
nToReadLabel
.
Caption:=IntToStr(nToRead);
while
ReadedBytes<nToRead
do
begin
ReadFile(Port,RCBuf^,nToRead,nRead,
nil
);
nReadLabel
.
Caption:=IntToStr(nRead);
ReadedBytes:=ReadedBytes+nRead;
RcDataLabel
.
Caption:=RCBuf;
Data
.
Add(RCBuf);
end
;
Data
.
SaveToFile(ExtractFilePath(ParamStr(
0
))+
'Output.txt'
);
Data
.
Free;
end
;
procedure
TMainForm
.
FormCreate(Sender: TObject);
begin
nToreadLabel
.
Caption:=
''
;
nReadLabel
.
Caption:=
''
;
RcDataLabel
.
Caption:=
''
;
ReadThr:=TReadThread
.
Create(
True
);
ReadThr
.
Priority:=tpNormal;
ReadThr
.
FreeOnTerminate:=
True
;
ReadThr
.
Start;
end
;
procedure
TMainForm
.
FormShow(Sender: TObject);
begin
RefreshComPrt;
end
;
procedure
TMainForm
.
FormClose(Sender: TObject;
var
Action: TCloseAction);
begin
end
;
end
.