⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 unit1.~pas

📁 GPRS_DTU设置程序源代码
💻 ~PAS
📖 第 1 页 / 共 3 页
字号:
  end
  else
    bsknstspnl4.Caption := ' STATUS: COM Port Closed';
end;

procedure TFrm_Main.ShowTX;
begin
  bsknstspnl6.Caption := 'Tx:' + IntToStr(FTXNum);
end;

procedure EnumComPorts(Ports: TStrings);
var
  KeyHandle: HKEY;
  ErrCode, Index: Integer;
  ValueName, Data: string;
  ValueLen, DataLen, ValueType: DWORD;
  TmpPorts: TStringList;
begin
  ErrCode := RegOpenKeyEx(HKEY_LOCAL_MACHINE, 'HARDWARE\DEVICEMAP\SERIALCOMM', 0,
    KEY_READ, KeyHandle);

  if ErrCode <> ERROR_SUCCESS then
    raise ERegError.Create('打开串口列表的注册表项出错');

  TmpPorts := 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(Data);
        Inc(Index);
      end
      else if ErrCode <> ERROR_NO_MORE_ITEMS then
        raise ERegError.Create('打开串口列表的注册表项出错');

    until (ErrCode <> ERROR_SUCCESS);

    TmpPorts.Sort;
    Ports.Assign(TmpPorts);
  finally
    RegCloseKey(KeyHandle);
    TmpPorts.Free;
  end;
end;

procedure TFrm_Main.FormCreate(Sender: TObject);
begin
  FRXNum := 0;
  FTXNum := 0;
  FShowText :=1;   //关闭与打开mmo1的返回信息显示
  //串口初始化
  EnumComPorts(cbb1.Items);    //得到串口列表
  Cbb1.ItemIndex := 0;
  cm1.CommName := cbb1.Text;
  cbb2.ItemIndex := 7;
  cm1.BaudRate := StrToInt(cbb2.Text);
  cbb3.ItemIndex := 0;
  Cm1.Parity := None;
  Cbb4.ItemIndex := 3;
  Cm1.ByteSize := _8;
  Cbb5.ItemIndex := 0;
  Cm1.StopBits := _1;

  //按钮控制
  btn1.Click;

end;

procedure TFrm_Main.btn2Click(Sender: TObject);
begin
  FRXNum := 0;
  FTXNum := 0;
  ShowRX;
  ShowTX;
end;

procedure TFrm_Main.tmr1Timer(Sender: TObject);
//var ec:Tcanvas;
begin
  if (btn12.Enabled) and (mmo2.Text <> '') then
  begin
    btn12.Click;
  end;
end;

procedure TFrm_Main.cbb2Change(Sender: TObject);
var
  BaudRate: Integer;
begin
  if cbb2.Text = 'Custom' then
  begin
    cbb2.SetFocus;
    btn1.Enabled := false;
  end
  else
  begin   
    if cbb2.ItemIndex > 0 then
      //下面是自定义波特率的
    if TryStrToInt(cbb2.Text, BaudRate) then
    begin
      cm1.BaudRate := BaudRate;
      btn1.Enabled := true;
    end
    else
      btn1.Enabled := false;
  end;
end;

procedure TFrm_Main.cbb1Change(Sender: TObject);
begin
   Cm1.CommName := cbb1.Text;
end;

procedure TFrm_Main.cbb3Change(Sender: TObject);
begin
  //TParity = ( None, Odd, Even, Mark, Space );
  Cm1.Parity := TParity(cbb3.ItemIndex);
end;

procedure TFrm_Main.cbb4Change(Sender: TObject);
begin
Cm1.ByteSize := TByteSize(cbb4.ItemIndex);
end;

procedure TFrm_Main.cbb5Change(Sender: TObject);
begin
  //TStopBits = ( _1, _1_5, _2 );
  Cm1.StopBits := TStopBits(cbb5.ItemIndex);
end;

procedure TFrm_Main.cbb2KeyPress(Sender: TObject; var Key: Char);
begin
  if not (Key in ['0'..'9', #8]) then 
    Key := #0;
end;

procedure TFrm_Main.bsknchckrdbx2Click(Sender: TObject);
begin
bsknstspnl3.Caption:='通信模式';
SendString('AT+REST=1'+chr(13));
mmo1.Clear;
mmo1.Lines.Add('>>> 串口('+cbb1.Text+')已打开,请给设备上电(如果已上电将直接进入通信模式)');
mmo1.Lines.Add('当前处于通讯状态...');
mmo2.Enabled:=True;
bskngrpbx2.Enabled:=True;
bskngrpbx4.Enabled:=False;
btn4.Enabled:=False;
tmr3.Enabled := False ;
  btn6.Enabled := False ;
  btn7.Enabled := False ;
  btn8.Enabled := False ;
  btn9.Enabled := False ;
  btn10.Enabled := False ;
  btn11.Enabled := False ;
  btn5.Enabled := False ;
  btn21.Enabled := False ;
  btn20.Enabled := False ;
  btn22.Enabled := False ;
  btn4.Enabled := False ;
  btn24.Enabled := False ;
end;

procedure TFrm_Main.bsknchckrdbx1Click(Sender: TObject);
begin
bsknstspnl3.Caption:='正在联机';
mmo2.Enabled:=False;
bskngrpbx2.Enabled:=False;
chk1.Checked := False ;
mmo1.Clear ;
    mmo1.Lines.Add('>>> 串口('+cbb1.Text+')已打开,请给设备上电(如果已上电请重新上电)');
    mmo1.Lines.Add('正在等待设备上电后进入配置状态...');
mmo2.Clear;
tmr3.Enabled := True ;
end;

procedure TFrm_Main.rb2Click(Sender: TObject);
begin
bskngrpbx5.Enabled:=False;
bskngrpbx6.Enabled:=True;
end;

procedure TFrm_Main.rb1Click(Sender: TObject);
begin
bskngrpbx5.Enabled:=True;
bskngrpbx6.Enabled:=False;
end;

procedure TFrm_Main.btn6Click(Sender: TObject);
begin
SendString('AT+BAUD=?'+chr(13));
end;

procedure TFrm_Main.btn13Click(Sender: TObject);
begin
mmo2.Clear;
end;

procedure TFrm_Main.btn16Click(Sender: TObject);
begin
mmo1.Clear;
end;

procedure TFrm_Main.btn12Click(Sender: TObject);
begin
if chk2.Checked then
    SendString(HexStrToStr(mmo2.Text))
else
    SendString(mmo2.Text);
end;

procedure TFrm_Main.cm1ReceiveData(Sender: TObject; Buffer: Pointer;
  BufferLength: Word);
var
  Str: string;
begin
  //Memo自动清空
  if chk3.Checked and (mmo1.Lines.Count > 50) then
    mmo1.Clear;
  //下面两句是SPCOMM控件的接收数据的读取方法
  //如果要读取到pchar时可以  (读取到字符数组时同理)
  //var buf : pchar;
  //GetMem(buf,BufferLength);
  //Move(buffer^, buf^, bufferlength);
  SetLength(Str, BufferLength);
  Move(buffer^, PChar(@Str[1])^, bufferlength);
  backStr:=Str;
  if FShowText=1 then
  begin
    if chk4.Checked then
      mmo1.Text := mmo1.Text + StrToHexStr(Str) + ' '
    else
      mmo1.Text := mmo1.Text + Str;
    //下面几句是让mmo1下拉的,让接收的数据始终在最前面
    mmo1.SelStart  := Length(mmo1.Text);
    mmo1.SelLength := 0;
    mmo1.Perform(EM_SCROLLCARET, 0, 0);
  end;
  if (Pos('ERROR'+chr(13),Str) > 0) and (tmr3.Enabled = True) then
  begin
  tmr3.Enabled := False ;
  bsknstspnl3.Caption:='联机成功';
  btn3.Enabled := True ;
  btn6.Enabled := True ;
  btn7.Enabled := True ;
  btn8.Enabled := True ;
  btn9.Enabled := True ;
  btn10.Enabled := True ;
  btn11.Enabled := True ;
  btn5.Enabled := True ;
  btn21.Enabled := True ;
  btn20.Enabled := True ;
  btn22.Enabled := True ;
  btn4.Enabled := True ;
  bskngrpbx4.Enabled:=True ;
  btn24.Enabled := True ;
  end;

  //判断是否进入工程模式,如果进入就不再发进入工程模式命令!
  //if StrToHexStr(Str) ='49 6E 69 74 20 63 6F 6D 6D 61 6E 64 20 4C 69 73 74 3A 0D 0A ' then
  //  if   pos(T,mmo1.text)>0   then
   //   showmessage('含有该字符串');
  if Pos('Init command List:'+chr(13),Str) > 0 then  //判断Str中有没有 Init command List:
  //if copy(UpperCase(backStr),1,5)='ERROR'#$D#$A then
  //if backStr = 'ERROR'#$D#$A then
  //if Str = 'ERROR'+chr(13) then
  begin
  tmr3.Enabled := False ;
  bsknstspnl3.Caption:='联机成功';
  btn3.Enabled := True ;
  btn6.Enabled := True ;
  btn7.Enabled := True ;
  btn8.Enabled := True ;
  btn9.Enabled := True ;
  btn10.Enabled := True ;
  btn11.Enabled := True ;
  btn5.Enabled := True ;
  btn21.Enabled := True ;
  btn20.Enabled := True ;
  btn22.Enabled := True ;
  btn4.Enabled := True ;
  bskngrpbx4.Enabled:=True ;
  btn24.Enabled := True ;
  //FShowText :=1;
  end;
  //else
  //if tmr3.Enabled = False then
  //begin
     //FShowText :=1;
  //end;

  FRXNum := FRXNum + bufferlength;
  ShowRX;
end;

procedure TFrm_Main.btn17Click(Sender: TObject);
begin
  if btn17.Caption = '停止显示' then
  begin
    btn17.Caption := '继续显示';
    FShowText := 0;
  end
  else
  begin
    btn17.Caption := '停止显示';
    FShowText := 1;
  end;
end;

procedure TFrm_Main.chk1Click(Sender: TObject);
begin
  tmr1.Enabled := chk1.Checked;
  edt23.Enabled := not chk1.Checked;
end;

procedure TFrm_Main.edt23Change(Sender: TObject);
var
  Interval: Integer;
begin
  if TryStrToInt(edt23.Text, Interval) and (Interval > 0) then
  begin
    tmr1.Interval    := Interval;
    chk1.Enabled := true;
  end
  else
    chk1.Enabled := false;
end;

procedure TFrm_Main.btn14Click(Sender: TObject);
begin
 if bsknpndlg1.Execute then
    edt24.Text := bsknpndlg1.FileName;
end;

procedure TFrm_Main.btn15Click(Sender: TObject);
begin
  if FileExists(edt24.Text) then
    SendFile(edt24.Text);
end;

procedure TFrm_Main.cbb6Change(Sender: TObject);
begin
if rb1.Checked = True then
begin
if cbb6.Text = '1' then
begin
lbl8.Visible := False ;
edt2.Visible := False ;
edt7.Visible := False ;
lbl9.Visible := False ;
edt3.Visible := False ;
edt8.Visible := False ;
lbl10.Visible := False ;
edt4.Visible := False ;
edt9.Visible := False ;
lbl11.Visible := False ;
edt5.Visible := False ;
edt10.Visible := False ;
end;
if cbb6.text='2' then
begin
lbl8.Visible := True ;
edt2.Visible := True ;
edt7.Visible := True ;
lbl9.Visible := False ;
edt3.Visible := False ;
edt8.Visible := False ;
lbl10.Visible := False ;
edt4.Visible := False ;
edt9.Visible := False ;
lbl11.Visible := False ;
edt5.Visible := False ;
edt10.Visible := False ;
end;
if cbb6.text='3' then
begin
lbl8.Visible := True ;
edt2.Visible := True ;
edt7.Visible := True ;
lbl9.Visible := True ;
edt3.Visible := True ;
edt8.Visible := True ;
lbl10.Visible := False ;
edt4.Visible := False ;
edt9.Visible := False ;
lbl11.Visible := False ;
edt5.Visible := False ;
edt10.Visible := False ;
end;
if cbb6.text='4' then
begin
lbl8.Visible := True ;
edt2.Visible := True ;
edt7.Visible := True ;
lbl9.Visible := True ;
edt3.Visible := True ;
edt8.Visible := True ;
lbl10.Visible := True ;
edt4.Visible := True ;
edt9.Visible := True ;
lbl11.Visible := False ;
edt5.Visible := False ;
edt10.Visible := False ;
end;
if cbb6.text='5' then
begin
lbl8.Visible := True ;
edt2.Visible := True ;
edt7.Visible := True ;
lbl9.Visible := True ;
edt3.Visible := True ;
edt8.Visible := True ;
lbl10.Visible := True ;
edt4.Visible := True ;
edt9.Visible := True ;
lbl11.Visible := True ;
edt5.Visible := True ;
edt10.Visible := True ;
end;
end
else
begin
if cbb6.Text = '1' then
begin
lbl16.Visible := False ;
edt14.Visible := False ;
edt19.Visible := False ;
lbl17.Visible := False ;
edt15.Visible := False ;
edt20.Visible := False ;
lbl18.Visible := False ;
edt16.Visible := False ;
edt21.Visible := False ;
lbl19.Visible := False ;
edt17.Visible := False ;
edt22.Visible := False ;
end;
if cbb6.Text = '2' then
begin
lbl16.Visible := True ;
edt14.Visible := True ;
edt19.Visible := True ;
lbl17.Visible := False ;
edt15.Visible := False ;
edt20.Visible := False ;
lbl18.Visible := False ;
edt16.Visible := False ;
edt21.Visible := False ;
lbl19.Visible := False ;
edt17.Visible := False ;
edt22.Visible := False ;
end;
if cbb6.Text = '3' then
begin
lbl16.Visible := True ;
edt14.Visible := True ;
edt19.Visible := True ;
lbl17.Visible := True ;
edt15.Visible := True ;
edt20.Visible := True ;
lbl18.Visible := False ;
edt16.Visible := False ;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -