unit1.~pas

GPRS_DTU设置程序源代码

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, WinSkinData, ComCtrls, ExtCtrls, StdCtrls, SPComm, SkinCtrls,
  spSkinShellCtrls, DynamicSkinForm, WinSkinStore, Menus, fcStatusBar,
  bsSkinCtrls, BusinessSkinForm, bsSkinData, bsSkinBoxCtrls, bsdbctrls,
  RzStatus, RzPanel, Mask, DBCtrls, RzDBEdit, RzEdit, bsSkinTabs, IPEdit,
  bsSkinShellCtrls,shlobj;

type
  TFrm_Main = class(TForm)
    cm1: TComm;
    tmr1: TTimer;
    bsbsnsknfrm1: TbsBusinessSkinForm;
    bskndt1: TbsSkinData;
    bscmprsdstrdskn1: TbsCompressedStoredSkin;
    bskngrpbx1: TbsSkinGroupBox;
    cbb1: TbsSkinComboBox;
    cbb2: TbsSkinComboBox;
    cbb3: TbsSkinComboBox;
    cbb4: TbsSkinComboBox;
    cbb5: TbsSkinComboBox;
    bskngrpbx0: TbsSkinGroupBox;
    lbl1: TbsSkinStdLabel;
    lbl2: TbsSkinStdLabel;
    lbl3: TbsSkinStdLabel;
    bskngrpbx2: TbsSkinGroupBox;
    bsknstsbr1: TbsSkinStatusBar;
    bsknstspnl1: TbsSkinStatusPanel;
    bsknstspnl2: TbsSkinStatusPanel;
    bsknstspnl4: TbsSkinStatusPanel;
    bsknstspnl3: TbsSkinStatusPanel;
    bsknstspnl5: TbsSkinStatusPanel;
    bsknstspnl6: TbsSkinStatusPanel;
    btn2: TbsSkinButton;
    mmo1: TRzMemo;
    mmo2: TRzMemo;
    lbl4: TbsSkinStdLabel;
    lbl5: TbsSkinStdLabel;
    bskngrpbx4: TbsSkinGroupBox;
    bsknpgcntrl1: TbsSkinPageControl;
    bskntbsht1: TbsSkinTabSheet;
    bskntbsht2: TbsSkinTabSheet;
    lbl6: TbsSkinStdLabel;
    cbb6: TbsSkinComboBox;
    bskngrpbx5: TbsSkinGroupBox;
    edt1: TIPAddressEdit;
    edt2: TIPAddressEdit;
    edt3: TIPAddressEdit;
    edt4: TIPAddressEdit;
    edt5: TIPAddressEdit;
    lbl7: TbsSkinStdLabel;
    lbl8: TbsSkinStdLabel;
    lbl9: TbsSkinStdLabel;
    lbl10: TbsSkinStdLabel;
    lbl11: TbsSkinStdLabel;
    edt6: TEdit;
    skndt1: TSkinData;
    edt7: TEdit;
    edt8: TEdit;
    edt9: TEdit;
    edt10: TEdit;
    bskngrpbx6: TbsSkinGroupBox;
    lbl13: TLabel;
    grp1: TGroupBox;
    lbl12: TLabel;
    edt11: TIPAddressEdit;
    edt12: TIPAddressEdit;
    lbl14: TLabel;
    grp2: TGroupBox;
    lbl15: TLabel;
    lbl16: TLabel;
    lbl17: TLabel;
    lbl18: TLabel;
    lbl19: TLabel;
    edt13: TEdit;
    edt14: TEdit;
    edt15: TEdit;
    edt16: TEdit;
    edt17: TEdit;
    edt18: TEdit;
    edt19: TEdit;
    edt20: TEdit;
    edt21: TEdit;
    edt22: TEdit;
    rb1: TRadioButton;
    rb2: TRadioButton;
    btn1: TButton;
    btn6: TButton;
    btn7: TButton;
    btn8: TButton;
    btn9: TButton;
    btn10: TButton;
    btn11: TButton;
    grp3: TGroupBox;
    lbl20: TLabel;
    chk1: TCheckBox;
    chk2: TCheckBox;
    edt23: TEdit;
    btn12: TButton;
    btn13: TButton;
    lbl21: TLabel;
    btn14: TButton;
    edt24: TEdit;
    btn15: TButton;
    chk3: TCheckBox;
    chk4: TCheckBox;
    btn16: TButton;
    btn17: TButton;
    lbl22: TLabel;
    cbb7: TbsSkinComboBox;
    edt25: TEdit;
    btn18: TButton;
    btn19: TButton;
    bsknpndlg1: TbsSkinOpenDialog;
    tmr2: TTimer;
    tmr3: TTimer;
    btn5: TButton;
    btn20: TButton;
    btn21: TButton;
    btn22: TButton;
    btn4: TButton;
    rb3: TRadioButton;
    rb4: TRadioButton;
    chk5: TCheckBox;
    cbb8: TbsSkinComboBox;
    lbl23: TLabel;
    lbl24: TLabel;
    edt26: TEdit;
    lbl25: TLabel;
    edt27: TEdit;
    lbl26: TLabel;
    edt28: TEdit;
    lbl27: TLabel;
    cbb9: TbsSkinComboBox;
    lbl28: TLabel;
    edt29: TEdit;
    lbl29: TLabel;
    edt30: TEdit;
    lbl30: TLabel;
    edt31: TEdit;
    btn24: TButton;
    lbl31: TLabel;
    edt32: TEdit;
    lbl32: TLabel;
    edt33: TEdit;
    lbl33: TLabel;
    edt34: TEdit;
    lbl34: TLabel;
    edt35: TEdit;
    lbl35: TLabel;
    edt36: TEdit;
    lbl36: TLabel;
    edt37: TEdit;
    lbl37: TLabel;
    edt38: TEdit;
    lbl38: TLabel;
    edt39: TEdit;
    lbl39: TLabel;
    edt40: TEdit;
    bsknchckrdbx1: TRadioButton;
    bsknchckrdbx2: TRadioButton;
    btn3: TButton;
    btn23: TButton;
    btn25: TButton;
    btn26: TButton;
    btn27: TButton;
    btn28: TButton;
    btn29: TButton;
    btn30: TButton;
    btn31: TButton;
    btn32: TButton;
    btn33: TButton;
    btn34: TButton;
    btn35: TButton;
    btn36: TButton;
    btn37: TButton;
    btn38: TButton;
    btn39: TButton;
    btn40: TButton;
    btn41: TButton;
    procedure btn1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btn2Click(Sender: TObject);
    procedure tmr1Timer(Sender: TObject);
    procedure cbb2Change(Sender: TObject);
    procedure cbb1Change(Sender: TObject);
    procedure cbb3Change(Sender: TObject);
    procedure cbb4Change(Sender: TObject);
    procedure cbb5Change(Sender: TObject);
    procedure cbb2KeyPress(Sender: TObject; var Key: Char);
    procedure bsknchckrdbx2Click(Sender: TObject);
    procedure bsknchckrdbx1Click(Sender: TObject);
    procedure rb2Click(Sender: TObject);
    procedure rb1Click(Sender: TObject);
    procedure btn6Click(Sender: TObject);
    procedure btn13Click(Sender: TObject);
    procedure btn16Click(Sender: TObject);
    procedure btn12Click(Sender: TObject);
    procedure cm1ReceiveData(Sender: TObject; Buffer: Pointer;
      BufferLength: Word);
    procedure btn17Click(Sender: TObject);
    procedure chk1Click(Sender: TObject);
    procedure edt23Change(Sender: TObject);
    procedure btn14Click(Sender: TObject);
    procedure btn15Click(Sender: TObject);
    procedure cbb6Change(Sender: TObject);
    procedure tmr2Timer(Sender: TObject);
    procedure cbb7Change(Sender: TObject);
    procedure btn18Click(Sender: TObject);
    procedure btn19Click(Sender: TObject);
    procedure tmr3Timer(Sender: TObject);
    procedure btn4Click(Sender: TObject);
    procedure btn3Click(Sender: TObject);
    procedure btn7Click(Sender: TObject);
    procedure btn8Click(Sender: TObject);
    procedure btn10Click(Sender: TObject);
    procedure btn11Click(Sender: TObject);
    procedure btn5Click(Sender: TObject);
    procedure btn9Click(Sender: TObject);
    procedure btn20Click(Sender: TObject);
    procedure btn21Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure btn24Click(Sender: TObject);
    procedure btn22Click(Sender: TObject);
    procedure btn23Click(Sender: TObject);
    procedure btn25Click(Sender: TObject);
    procedure btn26Click(Sender: TObject);
    procedure btn27Click(Sender: TObject);
    procedure btn28Click(Sender: TObject);
    procedure btn29Click(Sender: TObject);
    procedure btn30Click(Sender: TObject);
    procedure btn31Click(Sender: TObject);
    procedure btn32Click(Sender: TObject);
    procedure btn33Click(Sender: TObject);
  private
    { Private declarations }
    FRXNum: Cardinal;
    FTXNum: Cardinal;
    backStr: string;
    procedure ShowRX;
    procedure ShowTX;
    procedure ShowStatus;
    procedure SendFile(const FileName: string);
    procedure SendString(const Str: string);
    //procedure WMSysCommand(var Message: TWMSysCommand); message WM_SYSCOMMAND;
  public
    { Public declarations }
  end;

var
  Frm_Main: TFrm_Main;
  FShowText: Integer;
implementation
 type
     ERegError = class(Exception);
     const
  idHelp  = $F200;
  idAbout = $F201;
{$R *.dfm}

//选择目录函数，需包含 shlobj 单元
function SelectDirectory(Handle: hwnd; const Caption: string;
  const Root: WideString; out Directory: string): Boolean;
var
  lpBI: _BrowseInfo;
  Buf: array[0..MAX_PATH] of Char;
  ID: IShellFolder;
  Eaten, Att: Cardinal;
  rt: pItemIDList;
  initdir: PWideChar;
begin
  Result := false;
  lpbi.hwndOwner := Handle;
  lpbi.lpfn := nil;
  lpbi.lpszTitle := PChar(Caption);
  //lpbi.ulFlags := BIF_RETURNONLYFSDIRS + BIF_EDITBOX;
  lpbi.ulFlags := BIF_RETURNONLYFSDIRS + BIF_NEWDIALOGSTYLE;
  SHGetDesktopFolder(ID);
  initdir := PWChar(Root);
  ID.ParseDisplayName(0, nil, InitDir, Eaten, rt, Att);
  lpbi.pidlRoot := rt;
  GetMem(lpbi.pszDisplayName, MAX_PATH);
  try
    Result := SHGetPathFromIDList(SHBrowseForFolder(lpbi), buf);
  except
    FreeMem(lpbi.pszDisplayName);
  end;
  if Result then 
  begin
    Directory := buf;
    if Length(Directory) <> 3 then
      Directory := Directory + '\';
  end;
end;

function StrToHexStr(const S: string): string;
  //字符串转换成16进制字符串
var
  I: Integer;
begin
  for I := 1 to Length(S) do
  begin
    if I = 1 then
      Result := IntToHex(Ord(S[1]), 2)
    else
      Result := Result + ' ' + IntToHex(Ord(S[I]), 2);
  end;
end;

procedure TFrm_Main.btn1Click(Sender: TObject);
begin
  //判断按键的状态可以避免打开串口出错时，要按两次按键
  if btn1.Caption = '打开串口' then
  begin
    cm1.StartComm;  //打开串口
    btn1.Caption := '关闭串口';
    bsknstspnl2.Caption:='串口已打开';
    if  bsknchckrdbx1.Checked=True then
    begin
    //mmo1.Text := mmo1.Text + '>>> 串口(COM3)已打开，请给设备上电(如果已上电请重新上电)正在等待设备上电后进入配置状态...' + ' ';
    mmo1.Clear;
    mmo1.Lines.Add('>>> 串口('+cbb1.Text+')已打开，请给设备上电(如果已上电请重新上电)');
    mmo1.Lines.Add('正在等待设备上电后进入配置状态...');
    end;
    if  bsknchckrdbx2.Checked=True then
    begin
    mmo1.Clear;
    mmo1.Lines.Add('>>> 串口('+cbb1.Text+')已打开，请给设备上电(如果已上电将直接进入通信模式)');
    mmo1.Lines.Add('当前处于通讯状态...');
    end;
    btn12.Enabled := True ;
    btn15.Enabled := True ;
    cbb1.Enabled := false;
    cbb2.Enabled := false;
    cbb3.Enabled := false;
    cbb4.Enabled := false;
    cbb5.Enabled := false;
    if bsknchckrdbx1.Checked=True then
    begin
    tmr3.Enabled := True  ;
    end;

    //btnSend.Enabled   := true;
  end
  else //if Button1.Caption = '关闭串口' then
  begin
    cm1.StopComm;  // 关闭串口
    btn1.Caption := '打开串口';
    bsknstspnl2.Caption:='串口已关闭';
    mmo1.Clear ;
    mmo1.Lines.Add('>>> 串口已关闭！');
    btn12.Enabled := False ;
    btn15.Enabled := False ;
    cbb1.Enabled := true;
    cbb2.Enabled := true;
    cbb3.Enabled := true;
    cbb4.Enabled := true;
  cbb5.Enabled := true;
  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 ;
  bskngrpbx4.Enabled:=False;
  tmr3.Enabled := False ;
  btn4.Enabled := False ;
  btn24.Enabled := False ;
    //btnSend.Enabled   := false;
  end;
  ShowStatus;
end;

procedure TFrm_Main.SendString(const Str: string);
begin
  if Cm1.WriteCommData(PChar(Str), Length(Str)) then
  begin
    FTXNum := FTXNum + Cardinal(Length(Str));
    ShowTX;
  end;
end;

procedure TFrm_Main.SendFile(const FileName: string);
var
  f: file;
  xfer: Integer;
  buf: PChar;
  BufSize: Integer;
  myFileSize: Integer;
const
  CBUFSIZE = 1024;    //最大缓冲区大小
begin
  if not btn1.Enabled then
    Exit;
  AssignFile(f, FileName);
  FileMode := fmOpenRead;
  {$I-}
  Reset(f, 1);
  {$I+}

  myFileSize := FileSize(f);
  if myFileSize > CBUFSIZE then
    BufSize := CBUFSIZE
  else
    BufSize := myFileSize;   //文件小于CBUFSIZE的缓冲区为文件的大小

  GetMem(buf, BufSize);
  try
    repeat
      BlockRead(f, buf^, BufSize, xfer);
      //可在此处加入 sleep() 来 匹配接收端的速率，降低接收端的误码率
      //一般　50 - 200 就行了
      //同时可以通过减少最大缓冲区（CBUFSIZE）的大小来降低发送速率
      if xfer > 0 then
      begin
        Cm1.WriteCommData(buf, xfer);
        FTXNum := FTXNum + Cardinal(xfer);
        ShowTX;
      end;
    until xfer < BufSize;
  finally
    FreeMem(buf);
    CloseFile(f);
  end;
end;

function HexStrToStr(const S: string): string;
  //16进制字符串转换成字符串
var
  t: Integer;
  ts: string;
  M, Code: Integer;
begin
  t := 1;
  Result := '';
  while t <= Length(S) do
  begin   //xlh 2006.10.21
    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 TFrm_Main.ShowRX;
begin
  bsknstspnl5.Caption := 'Rx:' + IntToStr(FRXNum);
end;

procedure TFrm_Main.ShowStatus;
begin
  if btn1.Caption = '关闭串口' then
  begin
    bsknstspnl4.Caption := Format(' STATUS: %s Opened %s %s %s %s', [cbb1.Text,
      {cbb2.Text,}IntToStr(cm1.BaudRate), cbb3.Text,
      cbb4.Text, cbb5.Text]);