procedure TForm1.EnumComPorts(Ports: TStrings); //获取当前可用的串口
var
KeyHandle: HKEY;
ErrCode, Index: Integer;
ValueName, Data: string;
ValueLen, DataLen, ValueType: DWORD;
TmpPorts: TStringList;
Tmp4,Tmp5:TStringList;
begin
ErrCode:= RegOpenKeyEx(HKEY_LOCAL_MACHINE,'HARDWARE\DEVICEMAP\SERIALCOMM',0,KEY_READ,KeyHandle); if ErrCode <> ERROR_SUCCESS then
ShowMessage('打开串口列表的注册表项出错');
TmpPorts := TStringList.Create;
Tmp4:= TStringList.Create;
Tmp5 := TstringList.Create;
try
Index := 0;
repeat
ValueLen := 256;
DataLen := 256;
SetLength(ValueName, ValueLen);
SetLength(Data, DataLen);
ErrCode := RegEnumValue(KeyHandle, Index, PChar(ValueName),
Cardinal(ValueLen), nil, @ValueType, PByte(PChar(Data)), @DataLen);
if ErrCode = ERROR_SUCCESS then
begin
SetLength(Data, DataLen);
TmpPorts.Add(Trim(Data));
Inc(Index);
end
else if ErrCode <> ERROR_NO_MORE_ITEMS then
ShowMessage('打开串口列表的注册表项出错');
until (ErrCode <> ERROR_SUCCESS);
TmpPorts.Sort;
For Index:=0 To TmpPorts.Count-1 do
begin
if Length(TmpPorts[Index])<=4 then // 'COM3'
Tmp4.Add(TmpPorts[Index])
else Tmp5.Add(TmpPorts[Index]);
end;
Tmp4.AddStrings(Tmp5);
//Ports.Assign(TmpPorts);
Ports.Assign(Tmp4);
finally
RegCloseKey(KeyHandle);
TmpPorts.Free;
Tmp4.Free;
Tmp5.Free;
end;
end;
function TForm1.HexStrToStr(const S: string): string; //16进制字符串转换成字符串
var
t:Integer;
ts:string;
M,Code:Integer;
begin
t:=1;
Result:='';
while t<=Length(S) do
begin
while (t<=Length(S)) and (not (S[t] in ['0'..'9','A'..'F','a'..'f'])) do
inc(t);
if (t+1>Length(S))or(not (S[t+1] in ['0'..'9','A'..'F','a'..'f'])) then
ts:='$'+S[t]
else
ts:='$'+S[t]+S[t+1];
Val(ts,M,Code);
if Code=0 then
Result:=Result+Chr(M);
inc(t,2);
end;
end;
procedure TForm1.SendString(const str: string);
begin
Comm1.WriteCommData(Pchar(str),Length(str));
end;
function TForm1.StrToHexStr(const S: string): string; //字符串转换成16进制字符串
var
I:Integer;
begin
for I:=1 to Length(S) do
begin
if I=1 then
Result:=IntToHex(StrToInt(S[1]),2)
else Result:=Result+' '+IntToHex(StrToInt(S[I]),2);
end;
end;
procedure TForm1.PortsChange(Sender: TObject); //端口选项
begin
Comm1.CommName:=Ports.Text;
end;
procedure TForm1.BaudChange(Sender: TObject); //波特率选项
begin
Comm1.BaudRate:=StrToIntDef(Baud.Text,Comm1.BaudRate)
end;
procedure TForm1.Parity_bitChange(Sender: TObject); //校验位选项
begin
case Parity_bit.ItemIndex of
0:Comm1.Parity:=Even;
1:Comm1.Parity:=Mark;
2:Comm1.Parity:=None;
3:Comm1.Parity:=Odd;
4:Comm1.Parity:=Space;
end;
end;
procedure TForm1.Data_bitsChange(Sender: TObject); //数据位选项
begin
case Data_bits.ItemIndex of
0:Comm1.ByteSize:=_5;
1:Comm1.ByteSize:=_6;
2:Comm1.ByteSize:=_7;
3:Comm1.ByteSize:=_8;
end;
end;
procedure TForm1.Stop_bitChange(Sender: TObject); //停止位选项
begin
case Stop_bit.ItemIndex of
0:Comm1.StopBits:=_1;
1:Comm1.StopBits:=_1_5;
2:Comm1.StopBits:=_2;
end;
end;
procedure TForm1.ConnectClick(Sender: TObject); //连接串口按钮事件
begin
if Connect.Caption='连接串口' then
begin
Comm1.StartComm;
Connect.Caption:='关闭串口';
Image1.Visible:=false;
Image2.Visible:=true;
Ports.Enabled:=false;
Baud.Enabled:=false;
Parity_bit.Enabled:=false;
Data_bits.Enabled:=false;
Stop_bit.Enabled:=false;
Senddisp.Enabled:=true;
end
else
begin
Comm1.StopComm;
Connect.Caption:='连接串口';
Image1.Visible:=true;
Image2.Visible:=false;
Ports.Enabled:=true;
Baud.Enabled:=true;
Parity_bit.Enabled:=true;
Data_bits.Enabled:=true;
Stop_bit.Enabled:=true;
Senddisp.Enabled:=false;
end;
end;
procedure TForm1.SenddispClick(Sender: TObject);
var
strdata,stryear1,stryear0,strmonth,strday,strhour,strminute,strsecond:string;
begin
if Time_settle.Checked=true then
begin
stryear1:=IntToHex(StrToInt(copy(IntToStr(SysTime.wYear),1,2)),2);
stryear0:=IntToHex(StrToInt(copy(IntToStr(SysTime.wYear),3,2)),2);
strmonth:=IntToHex(SysTime.wMonth,2);
strday:=IntToHex(SysTime.wDay,2);
strhour:=IntToHex(SysTime.wHour,2);
strminute:=IntToHex(SysTime.wMinute,2);
strsecond:=IntToHex(SysTime.wSecond,2);
strdata:=HexStrToStr('BBA2'+stryear1+stryear0+strmonth+strday+strhour+strminute+strsecond+IntToHex(SysTime.wMonth Xor $A2,2)+'EE');
if (trim(Total.Text) = '') or (trim(Total.Text) = '0') then
begin
SendString(HexStrToStr('BBAF01000000000000AFEE'));
//格式 BB+AF+发送数据的组数(H)+00+00+00+00+00++00+AF+EE
sleep(200);
SendString(strdata);
//格式 BB+A2+20+12+11+10+13+14+11+A2与月的异或+EE
Timer2.Enabled:=false;
end
else
begin
i0:=StrToInt(Total.Text);
SendString(HexStrToStr('BBAF'+IntToHex(i0+1,2)+'000000000000AFEE'));
//格式 BB+AF+发送数据的组数(H)+00+00+00+00+00++00+AF+EE
i:=1;
sleep(200);
SendString(strdata);
//格式 BB+A2+14(20)+0C(12)+0B(11)+0A(10)+0D(13)+0E(14)+0B(11)+A2与月(0B)的异或+EE
sleep(200);
Timer2.Enabled:=true;
end;
end
else
begin
if (trim(Total.Text) = '') or (trim(Total.Text) = '0') then
Application.MessageBox('数据无效，无法发送！','警告',MB_ICONWARNING)
else
begin
i0:=StrToInt(Total.Text);
SendString(HexStrToStr('BBAF'+IntToHex(i0,2)+'000000000000AFEE'));
//格式 BB+AF+发送数据的组数(H)+00+00+00+00+00++00+AF+EE
i:=1;
sleep(200);
Timer2.Enabled:=true;
end;
end;
end;
procedure TForm1.BatteryKeyPress(Sender: TObject; var Key: Char);
begin
if not (Key in ['0'..'9',#8]) then Key:=#0;
end;
procedure TForm1.Timer1Timer(Sender: TObject); //显示当前时间,每隔1s更新一次
begin
GetLocalTime(SysTime);
Time.Caption:=IntToStr(SysTime.wYear)+'年'+Format('%.2d',[SysTime.wMonth])+'月'+Format('%.2d',[SysTime.wDay])+'日 '+Format('%.2d',[SysTime.wHour])+':'+Format('%.2d',[SysTime.wMinute])+':'+Format('%.2d',[SysTime.wSecond]);
end;
procedure TForm1.Open_databaseClick(Sender: TObject);
var
constr: string;
begin
if ( constr <> '') then
ADOConnection1.ConnectionString := constr;
if (EditConnectionString(ADOConnection1)) then//调用数据源窗口，判断是否连接成功
begin
ADOConnection1.Connected:=False;
ADOConnection1.Connected:=True;
constr := ADOConnection1.ConnectionString;
Search.Enabled:=true;
end
else
begin
constr := ADOConnection1.ConnectionString;
ADOConnection1.ConnectionString := '';
end;
end;
procedure TForm1.AboutClick(Sender: TObject);
begin
Application.MessageBox(' ☆ 寝室电量提示系统 ☆'+#13#13+
' Agent CopyRight@2012 '+#13+
' by hun ','关于',MB_OK);
end;
procedure TForm1.SearchClick(Sender: TObject);
begin
ADOConnection1.Connected:=true;
with ADOQuery1 do
begin
Close;
SQL.Clear;
SQL.Add('SELECT * FROM Sheet1 WHERE Battery <='+Battery.Text); // 查询数据库
Open;
end;
ShowQueryData(StringGrid1,ADOQuery1,0,1);
if HaveData(StringGrid1, 1, 1)=false then
Total.Text:='0'
else
Total.Text:=SetNumberFields(StringGrid1,0,1);
ADOConnection1.Connected:=false;
end;
procedure TForm1.QuitClick(Sender: TObject);
begin
if Application.MessageBox('您确定要退出吗？','警告',MB_YESNO or MB_DEFBUTTON1)=IDYES then
begin
Application.Terminate;
end;
end;
procedure TForm1.Timer2Timer(Sender: TObject);
begin
SendString(HexStrToStr('BBA8'+StrToHexStr(Format('%.5d',[StrToInt(StringGrid1.Cells[1, i])]))+'0000'+IntToHex(StrToInt('$'+StrToHexStr(copy(StringGrid1.Cells[1, i],Length(StringGrid1.Cells[1, i])-2,1))) Xor $A8,2)+'EE'));
//格式 BB+A8+00+03+06+02+03+00+00+A8与03620的06h异或+EE
i:=i+1;
if i>i0 then
Timer2.Enabled:=false;
end;
procedure TForm1.Comm1ReceiveData(Sender: TObject; Buffer: Pointer;
BufferLength: Word);
var
rbuf:array[0..10] of Byte;
begin
move(Buffer^,pchar(@rbuf)^,BufferLength);
if (rbuf[1]<>rbuf[9]) or (inttohex(rbuf[2],2)='01') then
Application.MessageBox('显示失败！','提示信息',MB_OK)
else
begin
if inttohex(rbuf[2],2)='00' then
Application.MessageBox('显示成功！','提示信息',MB_OK)
else
Application.MessageBox('显示失败！','提示信息',MB_OK);
end;
end;
Label2: TLabel;
