main.pas

W78E516B在系统编程的上位机程序

unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, SPComm, ComCtrls, StdCtrls, ExtCtrls, Mask,inifiles,
  Menus, Buttons, XPMan,StrUtils;

type
  TFormMain = class(TForm)
    PageControl1: TPageControl;
    TabSheet2: TTabSheet;
    TabSheet4: TTabSheet;
    ButtonExit: TButton;
    RGCom: TRadioGroup;
    Comm: TComm;
    TimerOvertime: TTimer;
    ButtonCMGF: TButton;
    MemoData: TMemo;
    Label3: TLabel;
    EditBaudRate: TEdit;
    Label4: TLabel;
    EditDelay: TEdit;
    Label5: TLabel;
    Button4: TButton;
    Button5: TButton;
    Panel1: TPanel;
    CheckBox1: TCheckBox;
    ButtonAt: TButton;
    EditAt: TEdit;
    Button2: TButton;
    TabSheet1: TTabSheet;
    Label1: TLabel;
    LabelDelayLoop: TLabel;
    ButtonOpen: TButton;
    EditFileName: TEdit;
    ButtonDownload: TButton;
    TrackBar: TTrackBar;
    OpenDialog: TOpenDialog;
    Label2: TLabel;
    LabelSentNum: TLabel;
    CheckBox2: TCheckBox;
    Button1: TButton;
    procedure CommReceiveData(Sender: TObject; Buffer: Pointer;
      BufferLength: Word);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ButtonExitClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure RGComClick(Sender: TObject);
    procedure TimerOvertimeTimer(Sender: TObject);
    procedure ButtonAtClick(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure ButtonCMGFClick(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure EditBaudRateChange(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure ButtonOpenClick(Sender: TObject);
    procedure TrackBarChange(Sender: TObject);
    procedure ButtonDownloadClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    function hextoint(hexvalue:string):integer;
    function RFWrite(TheComm:TComm;WriteStr:string):Boolean;
    function OpenComm:Boolean;
    function BinaryDivide(SourceStr:string):string;
    function BinaryFuse(SourceStr:string):string;

    function EncodeGb(var s:WideString):String;
  public
    { Public declarations }
  end;

var
  FormMain: TFormMain;
  ReadString:string;
  rbuf,sbuf: array[1..512] of byte;
  DataReady:Boolean=False;
  ComChanged:Boolean=True;
  Timeout:Boolean=False;
 // destfile:file of byte;


implementation

{$R *.dfm}

//////////////////////////////////////////////////////
//                    串口接收事件响应过程
// 功能：接收串口输入数据
// 输入:无
// 输出:接收到的字符串==>ReadString(全局变量)
//      串口接收成功标志==>DataReady(全局变量)->True
//////////////////////////////////////////////////////
procedure TFormMain.CommReceiveData(Sender: TObject; Buffer: Pointer;
  BufferLength: Word);
var
  i:integer;
  numwrite:integer;
  tempstr,ShowStr:string;
begin
//接收数据
  tempstr:='';
  Showstr:='';
  move(buffer^,pchar(@rbuf)^,bufferlength);
 // blockwrite(destfile,buffer^,bufferlength,numwrite);
  for i:=1 to BufferLength do
  begin
    ShowStr:=ShowStr+inttohex(rBuf[i],2);
    tempstr:=tempstr+chr(rbuf[i]);
  end;
  ReadString:=tempstr;
  DataReady:=True;
  if Not CheckBox1.Checked then
    MemoData.Lines.Add(BinaryDivide(ReadString))
  else
    MemoData.Lines.Add(Readstring);
end;

procedure TFormMain.FormClose(Sender: TObject; var Action: TCloseAction);
var
  Inifilename:string;
  MyIniFile:TIniFile;
begin
  comm.StopComm;
  //串口设置写入配置文件
  IniFileName:=ExtractFileDir(Application.ExeName)+'\comset.ini' ;
  MyIniFile := TIniFile.Create(IniFileName);
  MyIniFile.WriteInteger('COM', 'comport',RGCom.ItemIndex);
  MyIniFile.Writestring('COM','baudrate',EditBaudRate.Text);
  MyIniFile.Writestring('COM','Delay',EditDelay.Text);
  MyIniFile.Free;
end;

////////////////////////////////////////////////
//          十六进制格式字符串转换为整数
//  输入: 压缩BCD码格式的两位十六进制数字符串
//  输出: 转换后对应的整数数值;若无法转换则返回 "-1"
//  说明: 暂时只能处理两位字符串
////////////////////////////////////////////////
function TFormMain.hextoint(hexvalue: string): integer;
var
  i,tempint,sum:integer;
  thechar:char;
begin
  sum:=0;
  for i:=1 to 2 do
  begin
    thechar:=hexvalue[i];
    case thechar of
      '0'..'9':tempint:=strtoint(thechar);
      'a','A':tempint:=10;
      'b','B':tempint:=11;
      'c','C':tempint:=12;
      'd','D':tempint:=13;
      'e','E':tempint:=14;
      'f','F':tempint:=15;
      else
        //MemoData.Lines.Add('错误的16进制字符类型');
        result:=-1;
        exit;
    end;
    sum:=sum*16+tempint;
  end;
  result:=sum;
end;
   ////////////////////////////////
function  TFormMain.EncodeGb(var s:WideString):String;
var
    i,len:integer;
    cur:integer;
    t:String;
begin
      Result:='';
      len:=Length(s);
      i:=1;
      while i<=len do
      begin
             cur:=ord(s[i]);
             FmtStr(t,'%4.4X',[cur]);
             Result:=Result+t;
             inc(i);
      end;

end;
 ///////////////////////
procedure TFormMain.ButtonExitClick(Sender: TObject);
begin
  close;
end;

procedure TFormMain.FormActivate(Sender: TObject);
var
  Inifilename:string;
  MyIniFile:TIniFile;
  comport:integer;
begin
  comport:=0;
  //若存在串口配置文件,则从文件中读出串口设置值
  IniFileName:=ExtractFileDir(Application.ExeName)+'\comset.ini' ;
  if FileExists(IniFileName) then
  begin
    MyIniFile := TIniFile.Create(IniFileName);
    comport:=MyIniFile.ReadInteger('COM', 'comport',0);
    EditBaudRate.Text :=MyIniFile.ReadString('COM', 'baudrate','11520');
    EditDelay.Text :=Myinifile.ReadString('COM','Delay','100');
    MyIniFile.Free;
  end;
  RGCom.ItemIndex :=comport;
 
  if OpenComm=False then exit;
end;

procedure TFormMain.RGComClick(Sender: TObject);
begin
  ComChanged:=True;
  if OpenComm=False then exit;
end;

function TFormMain.OpenComm: Boolean;
begin
  if ComChanged then
  begin
    Result:=False;
    //关闭串口,设置串口
    comm.StopComm;
    if RGCom.ItemIndex=0 then
      comm.CommName:='COM1'
    else
    if RGCom.ItemIndex=1 then
      Comm.CommName :='COM2'
    else
    if RGCom.ItemIndex=2 then
      comm.CommName:='COM3'
    else
    if RGCom.ItemIndex=3 then
      Comm.CommName :='COM4'
    else
    begin
      MessageDlg('没有选择有效串口',mtError,[mbok],0);
      exit;
    end;
    Comm.BaudRate:=strtoint(trim(EditBaudrate.Text ));
    //打开串口
    try
      comm.StartComm;
      Result:=True;
      FormMain.Caption :='BTS本地调试助手  '+Comm.CommName;
    except
      on E:Exception do
      begin
        MessageDlg('打开串口出错'+#13+e.Message,mtError,[mbok],0);
        exit;
      end;
    end;
    sleep(100);      //等待串口打开
    ComChanged:=False;
  end
  else
    Result:=True;
end;

////////////////////////////////////////////////////////////
//              串口发送函数
// 功能: 将一个字符串发送到指定的串口
// 输入: 已经打开的串口  TheComm(全局变量)
//       需要发送的字符串
// 输出: 发送是否成功的布尔值
// 思路: 将数据写入串口,并且开启超时定时器。若超时事件发生前全局变量DataReady仍
//       然为False，表示没有接收到返回数据，则超时退出
// 说明：在该函数中，用到了全局变量 ReadString、DataReady、TimeOut和定时器控件TimerOvertime。
//       接收到的数据保存在ReadString中
///////////////////////////////////////////////////////////
function TFormMain.RFWrite(TheComm:TComm;WriteStr:string): Boolean;
var
  cmd:string;
begin
  Result:=False;
  cmd:=WriteStr;
  ReadString:='';
  //发送
  if comm.WriteCommData(pchar(cmd),length(cmd))<>True then
  begin
    MessageDlg('数据发送出错',mtError,[mbok],0);
    exit;
  end;
  Result:=True;
end;

procedure TFormMain.TimerOvertimeTimer(Sender: TObject);
begin
  Timeout:=True;
  TimerOvertime.Enabled :=False;
end;

/////////////////////////////////////////////////////////////
//               二进制拆分函数
// 功能：将输入的字符串进行如下处理，逐个字符转换成ASCII码
//       8比特的十六进制数被划分成为高4bits和低4bits，对于高4bits和低4bits，
//       若其数字为0x00～0x09，则加上0x30，若其数字为0x0A～0x0F，则加上0x37
// 输入：可能包含非ASCII码字符的源字符串
// 输出：拆分后的ASCII码字符串，长度为源字符串的两倍
// 思路：循环用inttohex函数实现
/////////////////////////////////////////////////////////////
function TFormMain.BinaryDivide(SourceStr: string): string;
var
  i,Strlen,CharValue:integer;
  DestStr:string;
begin
  Strlen:=length(SourceStr);
  for i:=1 to Strlen do
  begin
    CharValue:=ord(SourceStr[i]);
    DestStr:=DestStr+inttohex(CharValue,2);
  end;
  Result:=DestStr;
end;

///////////////////////////////////////////////////
//              二进制融合函数
//  功能: 将输入的压缩BCD码格式的ASCII字符串,按照每两位结合成所代表整数的原则
//        转变成一半长度的字符串
//  输入: 压缩BCD码格式的ASCII字符串
//  输出: 融合后的字符串,可以包含各种字符
//        若融合成功,则长度是输入字符串的一半;若融合失败,则原字串返回
//  说明: 若输入字符串长度为奇数,则最后一位字符忽略
///////////////////////////////////////////////////
function TFormMain.BinaryFuse(SourceStr: string): string;
var
  i,charvalue:integer;
  unitnumber,DestStr:string;
begin
  for i:=1 to (length(Sourcestr) div 2) do
  begin
    unitnumber:=copy(SourceStr,i*2-1,2);
    charvalue:=hextoint(unitnumber);
    if charvalue<0 then
    begin
      //MemoData.Lines.Add('格式有误,无法进行二进制融合!');
      DestStr:=sourcestr;
      break;
    end
    else
      DestStr:=DestStr+chr(charvalue);
  end;
  Result:=DestStr;
end;

procedure TFormMain.ButtonAtClick(Sender: TObject);
var
  Cmd:string;
  i:integer;
  tempstr:string;
begin
  MemoData.Clear;
  Editat.Text :=trim(Editat.Text);
  if EditAt.Text ='' then
  begin
    showmessage('命令为空');
    exit;
  end;
  
  if length(EditAt.Text) >50 then
  begin
    showmessage('Command Too long !');
    exit;
  end;
  if OpenComm=False then exit;
  if CheckBox2.Checked then
  Cmd:=BinaryFuse(EditAt.Text)+#13
  else
  Cmd:=EditAt.Text+#13;
  EditAt.SelectAll;
  if PageControl1.ActivePage =TabSheet2 then
  EditAt.SetFocus;
  for i:=1 to length(cmd) do
  begin
    tempstr:=cmd[i];
    if Not RFWrite(comm,tempstr) then
    begin
      MessageDlg('At命令发送出错',mtError,[mbok],0);
      exit;
    end;
    sleep(strtoint(EditDelay.Text));
  end;

  CheckBox1.Checked:=True;

  if AnsiContainsStr( cmd,'get') then
   CheckBox1.Checked:=False;
end;

procedure TFormMain.CheckBox1Click(Sender: TObject);
begin
  if Not CheckBox1.Checked then
    MemoData.Text :=BinaryDivide(MemoData.Text)
  else
    MemoData.Text :=BinaryFuse(MemoData.Text);
end;

procedure TFormMain.ButtonCMGFClick(Sender: TObject);
begin
  EditAt.Text :='at+cmgf=1';
  ButtonAt.OnClick (self);
end;

procedure TFormMain.Button2Click(Sender: TObject);
begin
  MemoData.SelectAll;
  MemoData.CutToClipboard;
end;

procedure TFormMain.EditBaudRateChange(Sender: TObject);
begin
  ComChanged:=True;
end;

procedure TFormMain.Button4Click(Sender: TObject);
begin
  EditAt.Text :='atz';
  ButtonAt.OnClick (self);
end;

procedure TFormMain.Button5Click(Sender: TObject);
begin
  EditAt.Text :='atz;e';
  ButtonAt.OnClick (self);
end;

procedure TFormMain.ButtonOpenClick(Sender: TObject);
begin
  if OpenDialog.Execute then
  EditFileName.Text :=OpenDialog.FileName;
end;

procedure TFormMain.TrackBarChange(Sender: TObject);
begin
  LabelDelayLoop.Caption :=inttostr(TrackBar.Position );
end;

procedure TFormMain.ButtonDownloadClick(Sender: TObject);
var
  sourcefile:file of byte;
  buff:array[1..1024] of char;
  i,j,DelayLoop,numread:integer;
  size,sentnum:Longint;
  cmd:string;
  oldbaudrate:string;
begin
  if NOT FileExists(EditFileName.Text) then
  begin
    MessageDlg('错误的下载文件',mtError,[mbok],0);
    exit;
  end;
  DelayLoop:=TrackBar.Position;
  oldbaudrate:=EditBaudrate.Text;
  EditBaudrate.Text:='115200';
  ComChanged:=True;
  if OpenComm=False then exit;
  try
    assignfile(sourcefile,EditFileName.Text);
    reset(sourcefile);
    size:=FileSize(sourcefile);
    cmd:=chr(size mod 256);
    if comm.WriteCommData(pchar(cmd),length(cmd))<>True then
    begin
      MessageDlg('文件长度发送出错',mtError,[mbok],0);
      exit;
    end;
    for j:=0 to DelayLoop do Application.ProcessMessages ;
    cmd:=chr(size div 256);
    if comm.WriteCommData(pchar(cmd),length(cmd))<>True then
    begin
      MessageDlg('文件长度发送出错',mtError,[mbok],0);
      exit;
    end;
    sleep(20);
    sentnum:=0;
    while not eof(sourcefile) do
    begin
      blockread(sourcefile,buff,sizeof(buff),numread);
      for i:=1 to numread do
      begin
        cmd:=buff[i];
        if comm.WriteCommData(pchar(cmd),length(cmd))<>True then
        begin
          MessageDlg('数据发送出错',mtError,[mbok],0);
          exit;
        end;
        sentnum:=sentnum+1;
        LabelSentNum.Caption :=inttostr(sentnum);
        for j:=0 to DelayLoop do Application.ProcessMessages ;
      end;
    end;
    showmessage('下载完成');
  finally
    closefile(sourcefile);
    EditBaudrate.Text:=oldbaudrate;
    ComChanged:=True;
  end;
end;

procedure TFormMain.Button1Click(Sender: TObject);
var
    Widesms:WideString;
    temp:string;
begin
    Widesms:=WideString(EditAt.Text);
    temp:=EncodeGb(Widesms);
    MemoData.Lines.Add(temp);
    EditAt.Text:=inttostr(length(temp));

end;

end.