?? main.~pas
字號:
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);
end;
end.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -