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

📄 performpacket.pas

📁 STC-Download/STC-ISP下载工具(STC89C51单片机在线下载器) 必须组件: SPComm(必须), VCLSkin(可以去掉) -----------------------
💻 PAS
字号:
unit PerformPacket;
{
  说明: 3月30日,暂时取消了校验和检查,用户机器的调试版本
}

interface
uses
  Windows, Messages, SysUtils,Registry,Shlobj;

{------------------------------------------------------------------------------}
//公共函数定义
{------------------------------------------------------------------------------}
function MakePacket(mpHeader:String; mpAddress:String; mpData:String):String;	//生成数据包

function TransData(str :String):String;			  //转义处理
function ReTransData(str :String):String;		  //反转义处理
function GetCheckSum(csData : String):String;	//求校验和

function DeleteSubStr(Str, SubStr: String): String;     //删除字符串里的空格符号
function Replace (var Data, SubString1, SubString2 : string) : string;  //字符串替换
function HexToInt(const S: string): DWORD;              //16进制字符串转换成整形数
function AddStr0(Str :String;sLen :Integer): String;    //补齐字符串后面的0
function DLStr(Str :String; dLen :Integer): String;     //分离字符串
function ConvertDTMF(Str : String): String;             //转换DTMF字符
function ReConvertDTMF(Str : String): String;           //反转换DTMF字符
procedure RegisterFileType(prefix: string; exepfad: string);  //建立文件关联
procedure DeRegisterFileType(ft: String);               //删除文件关联

{------------------------------------------------------------------------------}
//常量定义
{------------------------------------------------------------------------------}
const
  //_DEBUG_ = true;     //调试版
  _DEBUG_ = false;    //发布版
  BUILDER_VER = '1.3';
  BUILDER_NAME = 'WuJiangTao';            //建造者
  PACKET_OK = '2800004F4B02009A7E';           //执行完毕,完整的数据包定义
  PACKET_ERROR = '2900004552524F5205018A7E';  //重发指令,完整的数据包定义
  TIMEOUT_NUM  =100;                      //最大超时计数器,时间 = TIMEOUT_NUM * 定时器间隔,当前设定为5秒
{------------------------------------------------------------------------------}
//单元全局变量定义
{------------------------------------------------------------------------------}

var
  //RxNum,TxNum   : Int64;
  LastPacket    : String;   //最后发送的数据包,用户错误重发
  BlockSend     : Boolean;  //发送阻塞,当发送完一条数据包时,BlockSend=True,当收到MCU的OK包时 BlockSend=false;
  BlockSendRead : Boolean;  //发送读阻塞
  OpBusy        : Boolean;  //操作忙
  NotCheckMsg   : Boolean;  //选择功能标志位时是否有提示

  TimeOutCount,             //超时计数器

  Len_LPhone,     //长话接入号码码长
  Len_CPhone,     //市话接入号码码长
  Len_APhone,     //本地区号码长

  Bank_Frb,       //禁拨号码码长存储组数
  Bank_Cps,       //市话号码码长存储组数
  Bank_Spe,       //特服号码长存储组数
  Bank_Ime3,      //3位立即发送号码码长存储组数
  Bank_Ime4,      //4位立即发送号码码长存储组数
  Bank_Ime5,      //5位立即发送号码码长存储组数
  Bank_Ime6,      //6位立即发送号码码长存储组数
  Bank_Mob        //移动通讯本地号段存储组数
                : Integer;


implementation

{------------------------------------------------------------------------------}
//公共函数实现过程
{------------------------------------------------------------------------------}
procedure msgbox(str:String);
begin
  MessageBox(0,Pchar(str),'Debug',mb_ok);
end;

procedure msgbox2(num:Integer);
begin
  MessageBox(0,Pchar(InttoStr(num)),'Debug',mb_ok);
end;


{-------------------------------------------------------------------------------
  功能: 字符串替换
  参数: Str:目标字符串 , subString1: 被替换的字符, subString2:字符
  返回: 字符串
-------------------------------------------------------------------------------}
function ForwardPos (var SubString, Data : string; StartPosition : byte) : byte;
var
  Position : integer;
begin
     if StartPosition < 1 then StartPosition := 1;
     Position := Pos (SubString, Copy (Data, StartPosition, Length(Data) - StartPosition + 1));
     if Position > 0 then ForwardPos := Pred(Position + StartPosition)
        else ForwardPos := 0; { Not found }
end;

function Replace (var Data, SubString1, SubString2 : string) : string;
var
  Index, Position : integer;
  TempString : string;
begin

     Index := 0;
     TempString := '';

     while Index < Length(Data) do begin

      Inc (Index);
      Position := ForwardPos (SubString1, Data, Index);

      if Index <> Position then
        TempString := TempString + Data[Index]
      else
      begin
        TempString := TempString + SubString2;
        Index := Position + Pred(Length (SubString1));
      end;

     end;

     Replace := TempString;
     
end;

{-------------------------------------------------------------------------------
  功能: 删除字符串里的空格符号
  参数: Str:目标字符串 , SubStr:要删除的字符
  返回: 字符串
-------------------------------------------------------------------------------}
function DeleteSubStr(Str, SubStr: String): String;
begin

  while Pos(SubStr, Str) <> 0 do
    Delete(Str, Pos(SubStr, Str), Length(SubStr));

  Result := Trim(Str);
  
end;

{-------------------------------------------------------------------------------
  功能: 转换字符(对所有的电话号码进行转换)
  参数: Str:目标字符串
  返回: 字符串
  说明: 将字符串里的所有"*"变成C,"*"变成B,"0"变成A
-------------------------------------------------------------------------------}
function ConvertDTMF(Str : String): String;
var
  Old,
  New,
  tmpStr :String;
begin
  tmpStr := Str;

  Old := '0'; New := 'A';
  tmpStr := Replace(tmpStr,Old,New);

  Old := '*'; New := 'B';
  tmpStr := Replace(tmpStr,Old,New);

  Old := '#'; New := 'C';
  tmpStr := Replace(tmpStr,Old,New);

  result := tmpStr;

end;
//反转换
function ReConvertDTMF(Str : String): String;
var
  Old,
  New,
  tmpStr :String;
begin
  tmpStr := Str;

  Old := 'A'; New := '0';
  tmpStr := Replace(tmpStr,Old,New);

  Old := 'B'; New := '*';
  tmpStr := Replace(tmpStr,Old,New);

  Old := 'C'; New := '#';
  tmpStr := Replace(tmpStr,Old,New);

  result := tmpStr;

end;
{-------------------------------------------------------------------------------
  功能: 分离字符串,字符串最后dLen位说明了有效位的长度
  参数: Str:目标字符串,dLen有效位的长度
  返回: 字符串
-------------------------------------------------------------------------------}
function DLStr(Str :String; dLen :Integer): String;
var
  //I,
  tLen : Integer;
  LenNum : Integer;
begin
  Str := Trim(Str);
  tLen := Length(Str)- dLen;
  //msgbox2(tlen);
  LenNum := HexToInt(copy(Str,tLen+1,dLen));
  Result := copy(Str,1,LenNum);

end;

{-------------------------------------------------------------------------------
  功能: 补齐字符串,如果Str长度未达到sLen长度,则在Str后补齐sLen-length(Str)个0
  参数: Str:目标字符串,sLen长度
  返回: 字符串
-------------------------------------------------------------------------------}
function AddStr0(Str :String;sLen :Integer): String;
var
  I,tLen : Integer;
  ZeroStr : String;
begin

  Str := Trim(Str);
  tLen := sLen - Length(Str)-1;
  
  for I := 0 to tLen do ZeroStr := ZeroStr+'0'; //生成"0"

  Str := Str + ZeroStr;

  Result := Str;

end;

{-------------------------------------------------------------------------------
  功能: 转义处理
  参数: str: 要发送的目标数据
  返回: 经过转义处理的数据字符串
  说明: 将与终止符"7E"相同的数据变换成 7E->(7D 5E),7D->(7D 5D)
-------------------------------------------------------------------------------}
function TransData(str :String):String;
var
  old,new: String;
begin

  Old := '7D';
  New := '7D5D';
  Str := Replace(str,old,new); //替换7D->[7D5D]

  Old := '7E';
  New := '7D5E';
  Str := Replace(str,old,new); //替换7E->[7D5E]
  result := str;

end;

{-------------------------------------------------------------------------------
  功能: 反转义处理
  参数: str: 已接收的目标数据
  返回: 经过反转义处理的数据字符串
  说明: 判断数据包内的以7D开头的下一个数据: (7D5D)->7D , (7D5E)->7E,
-------------------------------------------------------------------------------}
function ReTransData(str :String):String;
var
  old,new: String;
begin

  Old := '7D5D';
  New := '7D';
  Str := Replace(str,old,new); //替换 [7D5D]->7D

  Old := '7D5E';
  New := '7E';
  Str := Replace(str,old,new); //替换 [7D5E]->7E

  result := str;
end;

{-------------------------------------------------------------------------------
  功能: 求校验和
  参数: csData:目标字符串
  返回: 4位16进制字符串
  说明: 将字符串按2位一组进行求和运算。
-------------------------------------------------------------------------------}
function GetCheckSum(csData : String):String;
var
  tmpNum      : String;
  tSum,tLen,I : Integer;

begin
  I := 1;
  tSum := 0;
  tLen := length(csData);

  while I <= tLen do                      //计算校验和 对数据区进行校验
  begin

    tmpNum := copy(csData,I,2);
    //Debug(tmpNum);
    tSum := tSum + StrToInt('$'+tmpNum);  //将所有16进制数据转换成10进制计算
    I := I+2;

  end;

  result := InttoHex(tSum,4);             //将所有10进制数据转换成16进制字符串

end;

{-------------------------------------------------------------------------------
  功能: 生成数据包
  参数: mpHeader: 包头 , mpAddress: 数据地址 , mpData: 数据内容
  返回: String数据包
  说明: 根据要求,生成完整的string型数据包.增加: 长度计算,校验和,终止符,转义处理
-------------------------------------------------------------------------------}

function MakePacket(mpHeader:String; mpAddress:String; mpData:String):String;
var
  tData,
  tAddr,
  tPacket,
  tDataLen,
  tCheckSum : String;
begin
  { | 包头1 | 地址2 | 数据n | 校验和2 |7E结束标志1 }

  tData := DeleteSubStr(mpData,' ');            //删除数据空格
  tAddr := DeleteSubStr(mpAddress,' ');         //删除地址空格

  tCheckSum := GetCheckSum(tAddr+tData);        //求校验和 [ 地址+数据 ]
  tDataLen  := InttoHex(Length(tData) div 2,2); //求数据长度

  tPacket := mpHeader + mpAddress + tData + tDataLen + tCheckSum; //数据包(不含终止符)

  //tPacket := mpHeader + mpAddress + tData + tCheckSum; //数据包(不含终止符)
  tPacket := TransData(tPacket) + '7E';         //对数据进行转义处理+终止符"7E"

  result := tPacket;                            //生成完整的数据包

end;

{------------------------------------------------------------------------------}
//HexToInt转换过程
{------------------------------------------------------------------------------}
function HexToInt1(const S: String): DWORD; //比较慢
var
  I : Integer;
begin
  Result := 0;
  for I := 1 to Length(s) do
    begin
    case s[I] of
      '0'..'9': Result := Result * 16 + Ord(S[I]) - Ord('0');
      'A'..'F': Result := Result * 16 + Ord(S[I]) - Ord('A') + 10;
      'a'..'f': Result := Result * 16 + Ord(S[I]) - Ord('a') + 10;
    else
      Result := 0;
      Exit;
      end;
    end
end;

function HexToInt(const S: String): DWORD;  //比较快
asm
  PUSH EBX
  PUSH ESI

  MOV ESI, EAX //字符串地址
  MOV EDX, [EAX-4] //读取字符串长度

  XOR EAX, EAX //初始化返回值 
  XOR ECX, ECX //临时变量 

  TEST ESI, ESI //判断是否为空指针 
  JZ @@2 
  TEST EDX, EDX //判断字符串是否为空 
  JLE @@2 
  MOV BL, $20 
@@0: 
  MOV CL, [ESI] 
  INC ESI 

  OR CL, BL //如果有字母则被转换为小写字母 
  SUB CL, '0' 
  JB @@2 // < '0' 的字符 
  CMP CL, $09 
  JBE @@1 // '0'..'9' 的字符 
  SUB CL, 'a'-'0'-10 
  CMP CL, $0A 
  JB @@2 // < 'a' 的字符 
  CMP CL, $0F 
  JA @@2 // > 'f' 的字符 
@@1: // '0'..'9', 'A'..'F', 'a'..'f' 
  SHL EAX, 4 
  OR EAX, ECX 
  DEC EDX 
  JNZ @@0 
  JMP @@3 
@@2: 
  XOR EAX, EAX // 非法16进制字符串 
@@3: 
  POP ESI 
  POP EBX 
  RET 
end;

{------------------------------------------------------------------------------}
//读写注册表子程序
{------------------------------------------------------------------------------}
function ReadRegInfo():String;  //读Build信息
var
  reg:TRegistry;
  tStr :String;
begin
  reg:=TRegistry.Create;
  reg.RootKey:=hkey_local_machine;
  reg.OpenKey('Software\LinkFree',true);
  tStr := reg.ReadString('Builder');
  reg.CloseKey;
  result := tStr;
end;

procedure WriteRegInfo(str:String);        //写Build信息
var
  reg:TRegistry;
begin
  reg:=TRegistry.Create;
  reg.RootKey:=hkey_local_machine;
  reg.OpenKey('Software\LinkFree',true);
  reg.WriteString('Builder',str);
  reg.CloseKey;
end;

{------------------------------------------------------------------------------}
//建立文件关联
{------------------------------------------------------------------------------}
procedure RegisterFileType(prefix: string; exepfad: string);
var
  reg: TRegistry;
begin

  if ReadRegInfo() = BUILDER_NAME Then exit;  //如果已注册,则退出关联

  WriteRegInfo(BUILDER_NAME); //否则设置BuilderName

  //建立文件关联
  reg := TRegistry.Create;
  try

    reg.RootKey := HKEY_CLASSES_ROOT;
    reg.OpenKey('.' + prefix, True);

    try
      reg.Writestring('', prefix + 'file');
    finally
      reg.CloseKey;
    end;

    reg.CreateKey(prefix + 'file');
    reg.OpenKey(prefix+'file',True);
    try
    reg.WriteString('','LinkFree 配置文件');
    finally
    reg.CloseKey;
    end;
    
    reg.OpenKey(prefix + 'file\DefaultIcon', True);
    try
      reg.Writestring('', exepfad + ',2');
    finally
      reg.CloseKey;
    end;

    reg.OpenKey(prefix + 'file\shell\open\command', True);
    try
      reg.Writestring('', exepfad + ' "%1"');
    finally
      reg.CloseKey;
    end;

  finally
    reg.Free;
  end;

  SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_IDLIST, nil, nil);

end;

{------------------------------------------------------------------------------}
//删除文件关联
{------------------------------------------------------------------------------}
procedure DeRegisterFileType(ft: String);//ft: 将要删除文件关联的后缀 ,如 .tst
var
    myreg:TRegistry;
    key: String;
begin
    myreg:=TRegistry.Create;
    myReg.RootKey:=HKEY_CLASSES_ROOT;
    myReg.OpenKey(ft, False);
    key:=MyReg.ReadString('');
    MyReg.CloseKey;
    myReg.DeleteKey(ft);
    myReg.DeleteKey(key);
    myReg.Free;
end;


end.

⌨️ 快捷键说明

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