?? fmain.pas
字號:
output[j] := deb1;
i := i+2;
j := j+1;
end;
HexSTR2IntArray := output;
end;
procedure TMain.DevChangeArrival(Sender: TObject; ADeviceType: TDeviceType; APtr: Pointer);
begin
main.AddLinesLOG('- New COM port found .');
if ADeviceType <> dtPORT then exit;
REFRESH_REQUESTED := True;
end;
procedure TMain.DevChangeRemoveComplete(Sender: TObject; ADeviceType: TDeviceType; APtr: Pointer);
begin
if ADeviceType <> dtPORT then exit;
Main.AddLinesLOG('- COM port removed.');
REFRESH_REQUESTED := True;
end;
Function IntefaceInfo: STRING;
var
res : string;
begin
res := '';
if PortNum< MaxEnumComNum
then
begin
res := res + 'COM'+IntToStr(ComNum);
res := res +'@'+IntToStr(ComBaud)+' b/s ';
result := res;
main.AddLinesLog(result);
end;
end;
function ZComOpen : integer;
begin
if portnum > MaxEnumComNum
then
begin
if GetComStat
then
begin
result := 0;
exit;
end;
result := OpenCom(True);
end;
end;
Procedure Z_INTERFACE_CLOSE;
begin
if (ComNum<>0)
then // COM
begin
if GetComStat
then
begin
CloseCom;
main.AddLinesLog('<COM'+IntToStr(ComNum)+' interface closed>');
end;
end
end;
Function TMain.InitializeINTERFACE: boolean;
begin
result := False;
if PortNum = 0
then
begin
main.AddLinesLog('- Select First Interface');
exit;
end;
begin
if ComBaud =0
then
begin
Main.AddLinesLog('- Interface Speed auto-set : 115200 b/s');
ComBaud := 115200;
end;
ChangeComSpeed(ComBaud);
if ZComOpen <> 0
then
begin
Main.AddLinesLog('- Cant get the interface');
Z_INTERFACE_CLOSE;
exit;
end;
result := True;
end;
end;
function IntArray2ASCIIStr(Arr: Array of byte): String;
var len,i: integer;
txt: string;
a: string;
begin
len := length(Arr);
txt := '';
for i:=0 to len-1 do
begin
case Arr[i] of
$00 : txt := txt + NUL_CHAR; // Nul
else
begin
a := Chr(Arr[i]);
txt := txt + A;
end;
end;
end;
// SetLength(txt,Length(txt)-1);
RESULT := txt;
end;
Procedure Debugga(typ: shortint;arr: array of byte);
var len: integer;
str : String;
begin
with Main do
begin
len := length(arr);
if (len > 0) then
begin
str := IntToStr(len)+'> ';
while length(str)< 5 do
str := '0'+str;
case typ of
0 : begin
str := '<len:'+str;
main.AddLinesLog(str+IntArray2HexSTR(arr)+' ');
end;
2 :
begin
str := '<TX:'+str;
end;
3 :
begin
str := '<RX:'+str;
end;
4 :
begin
str := '<len:'+str;
end;
else AddLinesLog(IntArray2HexSTR(arr));
end
end
else AddLinesLog('- Phone Not Connected');
end;
end;
Function Send_CMD(CMD: Array of byte): boolean;
begin
result := False;
if not(Main.InitializeINTERFACE) then exit;
if (length(CMD) = 0)
then
begin
Main.AddLinesLOG('- Not Connected'+IntArray2HexSTR(CMD));
exit;
end;
Debugga(2,CMD);
if COMnum>0
then //COM
begin
result := WriteCom(@CMD, length(CMD));
exit;
end
end;
Function QUN_Serialize(DataPtr:T_IntVect): T_IntVect;
var buf1: T_IntVect;
i, offset, DataLEn : integer;
sel: boolean;
begin
sel := false;
offset := 0;
DataLEn := Length(DataPtr);
SetLength(buf1,DataLEn);
for i:=0 to DataLEn-2 do
case DataPTR[i] of
$7d : begin
setlength (buf1,length(buf1)-1);
Inc(offset);
sel := true;
end;
$5d : begin
if sel
then buf1[i-offset] := $7d
else buf1[i-offset] := $5d;
sel := false;
end;
$5e : begin
if sel
then buf1[i-offset] := $7e
else buf1[i-offset] := $5e;
sel := false;
end;
else buf1[i-offset] := DataPtr[i];
end;
result := buf1;
end;
function Z_PurgeCom(mode:Dword): boolean;
begin
result := False;
if portnum = 0 then exit;
if portnum > MaxEnumComNum
then //COM
begin
result := PurgeCom(mode);
exit;
end
end;
Function ReadCMD: T_IntVect;
var
buffy: Array [0..4] of byte;
reply : T_IntVect;
i, count : integer;
begin
i:= 1;
count:=0;
if ComNum>0
then //COM
while ReadCom(@buffy, 4) do
begin
i := 0;
while i<length(buffy)-1 do
begin
count := count+1;
setlength(reply,count);
reply[count-1] := buffy[i];
Inc(i);
end;
end;
result := QUN_Serialize(reply);
if count=0
then Z_PurgeCom(PURGE_RXCLEAR) ;
if not Z_PurgeCom(PURGE_RXCLEAR)
then Main.AddLinesLog('- Error after read');
Debugga(3,reply);
END;
Function DO_CMD(CMD_in: array of byte;ADD_CRC,ADD_EOq:boolean;READ_REPLY:Boolean): Boolean;
var
i,j,len : integer;
txt: String;
CHKsum : word;
CMD,reply : T_IntVect;
str:string;
DataPtr : pointer;
DataLen: Integer;
begin
str:='';
DO_CMD := False;
len := length(CMD_in);
if len = 0 then exit;
SetLength(CMD,len);
for i:=0 to len-1 do
CMD[i] := CMD_in[i];
DataPtr := CMD;
DataLen := Len;
while ((PByte(DataPtr)^)=$7e)
do
begin
Inc(PByte(DataPtr));
Dec(DataLen);
end;
if ADD_CRC then
begin
CHKsum := CRC16_Calc0(DataPtr, DataLen);
len := length(CMD);
end;
len:= Length(CMD);
if ADD_CRC then QAPPEND_CRC(CMD,CHKsum);
CMD := QSerialize(CMD);
len:= Length(CMD);
if ADD_EOq then
begin
if (CMD[len-1] <> EOq)
then
begin
len := Len+1;
SetLength(CMD,len);
CMD[len-1] := EOq;
end;
end;
if str<>'' then main.AddLinesLog(str);
if Send_CMD(CMD)
then DO_CMD := True
else exit;
if READ_REPLY
then
begin
DO_CMD := False;
reply := ReadCMD;
i:=0;
j:=0;
if (length(reply)=0) then
begin
Send_CMD(Q0_Refresh);
reply := ReadCMD;
if (length(reply)=0) then
begin
Main.AddLinesLOG('- Phone Delay Err..');
Main.AddLinesLOG('- Please Try again');
exit;
end;
end;
while reply[i] = $7e do Inc(i);
while CMD[j] = $7e do Inc(j);
if reply[0]=$13
then
begin
Main.AddLinesLog('- Phone State NOT Supported.');
DO_CMD := False;
exit;
end;
if CMD[j]=reply[i]
then
begin
DO_CMD := True;
exit;
end
else
if (length(reply)=4)
then
case reply[i] of
$02 : begin
DO_CMD := True;
exit;
end;
$03 : Main.AddLinesLog('- ERR_ILLEGAL_MODE');
$13 : Main.AddLinesLog('- ERR_CMD_NOT_ALLOWED');
$14 : Main.AddLinesLog('- ERR_SYNTAX_ERR');
$15 : Main.AddLinesLog('- ERR_illegal_DATA');
else Main.AddLinesLog('- ERR_ACK NO Reply: ? ? ? !');
end
else
if reply[i] = $03
then Main.AddLinesLog('- ERR_ILLEGAL_MODE');
end;
end;
procedure TMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Z_INTERFACE_CLOSE
end;
procedure TMain.Terminate;
begin
closecom;
end;
procedure TMain.Stop;
begin
Z_INTERFACE_CLOSE;
terminate;
end;
procedure TMain.AddLinesLog(s: string);
begin
Memo.Lines.Add(s);
end;
procedure TMain.error;
begin
AddLinesLog('- Select Com Interface');
AddLinesLog('- Make Sure Your Cable Connection is good');
AddLinesLog('- Check Phone Power');
exit;
end;
function GetQPCKType20(start,lung:dword): T_IntVect;
var qpck: T_IntVect;
begin
SetLength(qpck, 9);
qpck[0] := $01;
qpck[4] := start and $00000000;
qpck[3] := (start shr 8) and $00000000;
qpck[2] := (start shr 16) and $00000000;
qpck[1] := (start shr 24) and $00000000;
qpck[8] := lung and $0000FEAF;
qpck[7] := (lung shr 8) and $0000FFFF;
qpck[6] := (lung shr 16) and $0000FFFF;
qpck[5] := (lung shr 24) and $0000FFFF;
GetQPCKType20 := qpck;
end;
function rev_byte(arr: byte): byte;
var bar1,bar2 : byte;
begin
bar2 := arr and $F0;
bar2 := bar2 shr 4;
bar1 := arr and $0F;
bar1 := bar1 shl 4;
rev_byte := bar2+bar1;
end;
function GetQPCKType01(n: byte;lung:word;buf: array of byte): T_IntVect;
var pck: T_IntVect;
i,j, offset: integer;
CHKsum : word;
crc1,crc2 : byte;
begin
setlength (pck,lung+7);
pck[0] := EOQ;
pck[1] := 01;
pck[2] := SEPQ;
pck[3] := rev_byte(n);
pck[4] := SEPQ;
pck[5] := lung shr 8;
pck[6] := lung and $FFFF;
offset := 7;
for i:=0 to (lung-1) do
pck[i+offset] := buf[i];
CHKsum := CRC16_Calc0(@pck[0], length(pck)) ;
QAPPEND_CRC(pck,CHKsum);
Inc(n);
GetQPCKType01 := pck;
end;
function GetQPCKType21(start,lung:dword): T_IntVect; //DATAGRAM chk)
var qpck: T_IntVect;
begin
SetLength(qpck, 10);
qpck[0] := EOQ;
qpck[1] := $01;
qpck[5] := start and $00000000;
qpck[4] := (start shr 8) and $00000000;
qpck[3] := (start shr 16) and $00000000;
qpck[2] := (start shr 24) and $00000000;
qpck[9] := lung and $0000FEAF;
qpck[8] := (lung shr 8) and $0000FFFF;
qpck[7] := (lung shr 16) and $0000FFFF;
qpck[6] := (lung shr 24) and $0000FFFF;
GetQPCKType21 := qpck;
end;
Procedure TMain.StatusBar_UPDATE( phone: T_Handset_INFO);
begin
with StatusBar.Panels do
BEGIN
Items[0].Text := 'Phone Connected : ' + Phone.Model;
end;
end;
function GET_CMD(CMD: array of byte): T_IntVect;
var i,len: integer;
arr: T_IntVect;
CHKsum : word;
begin
len := length(CMD);
setlength(arr,len+3);
for i:=0 to len-1 do
arr[i] := CMD[i];
CHKsum := CRC16_Calc0(arr, len);
arr[len] := (CHKsum ) ;
arr[len+1] := (CHKsum Shr 8) and $00FF ;
arr[len+2] := EOq;
result := arr;
end;
Function GetPhoneInfo(arr: array of byte): T_Handset_INFO;
var phone : T_Handset_INFO;
arr2: array of byte;
i,j,len: integer;
txt : string;
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -