myfunction.~pas

tcp/ip通讯程序

unit MyFunction;

interface
var
    Port: string;
    Speed: string;
    DataBit:string;
    CheckBit:string;
    StopBit:string;

function Compu_Check(BA : array of byte;len : byte;var total:byte):byte;
function CalCheck(BA : array of byte,len : byte):Byte;
function Encrypt(AByte: byte):byte;
function AntiEncrypt(AByte: byte):byte;
function IsArrayValid(AByteAry : array of byte):Boolean;

function ComStrToInt(AComStr:string):smallint;
function EncryptStr(AStr:string):string;

function DataBuf_Change(mByteAry:array of byte;var Send_Buff_Chang:array of byte;Send_len:byte):byte;
function strTohex(str:string;var strHex:array of byte):integer;
function ConvertHexChar(ch:byte):byte;
//function DataChang(mIn_Buffer:array of byte;mIn_Count:byte;var outBuffer:array of byte):byte;
function DataChang(mIn_Buffer:array of byte;var outBuffer:array of byte;mIn_Count:byte):byte;
function strAddzero(bitNum:byte;oldStr:string):string;
implementation
uses
    Sysutils,Windows;

//计算校验和
function Compu_Check(BA : array of byte;len : byte ;var total:byte):byte;
var
    i:smallint;
    mTotal:byte;
begin
    mTotal := 0;
    for i:=0 to len do
    begin
        mTotal := mTotal + BA[i];
    end;
    total:=mTotal;
    Result := mTotal;
end;

//字符串位填充函数
function strAddzero(bitNum:byte;oldStr:string):string;
var  oldstrlen,len,i:byte;
     newStr:string;
begin
     newStr:='';
     oldstrlen:=Length(oldStr);
     len:=bitNum-oldstrlen;
     if len=0 then
          Result:=oldStr
     else begin
             for i:=0 to len-1 do
             begin
                  newStr:=newStr+'0';
             end;
             Result:=newStr+oldStr;
     end;
end;

//检查报文是否正确。
function IsArrayValid(AByteAry : array of byte):Boolean;
var
    i,mHigh : integer;
    mByte : byte;
begin
    //检查报文头部
    if (AByteAry[0] <> $0f)
        or (AByteAry[1] <> $f0) then
    begin
        Result := False;
        Exit;
    end;
    //mLen为AByteAry最后
    mHigh := Length(AByteAry)-1;
    //将$d2和所有报文作异或
    mByte := $d2;
    for i:=0 to mHigh-1 do
    begin
        mByte := mByte xor AByteAry[i];
    end;
    //检查校验位
    if mByte <> AByteAry[mHigh] then Result := False
    else Result := True;
end;

function CalCheck(BA : array of byte,len : byte):Byte;
var
    mByte,len,i:byte;
begin
    mByte := $0;
    for i:=0 to len do
    begin
        mByte := mByte xor Byte(BA[i]);
    end;
    Result := mByte;
end;

//加密数据
function Encrypt(AByte: byte):byte;
var
    mByte3,mByte6: byte;
begin
    //取第三位
    mByte3 := AByte and $8;
    //第三位移动第六位
    mByte3 := mByte3 shl 3;
    //取第六位
    mByte6 := AByte and $40;
    //第6位移动第3位
    mByte6 := mByte6 shr 3;
    //第6位\第3位交换位置
    AByte := AByte or mByte3;
    AByte := AByte or mByte6;
    //和$5d异或
    Result := (AByte xor $5d);
end;

//解密数据
function AntiEncrypt(AByte: byte):byte;
var
    mByte3,mByte6: byte;
begin
    //和$5d异或
    AByte := (AByte xor $5d);
    //取第三位
    mByte3 := AByte and $8;
    //第三位移动第六位
    mByte3 := mByte3 shl 3;
    //取第六位
    mByte6 := AByte and $40;
    //第6位移动第3位
    mByte6 := mByte6 shr 3;
    //第6位\第3位交换位置
    AByte := AByte or mByte3;
    AByte := AByte or mByte6;
    Result := AByte;
end;

function ComStrToInt(AComStr:string):smallint;
var
    mLen: integer;
    mResult: string;
begin
    mLen := Length(AComStr);
    mResult := Copy(AComStr,4,mLen-3);
    Result := StrToInt(mResult);
end;

//将要发送的数据转化为协议指定的数据
function DataBuf_Change(mByteAry:array of byte;var Send_Buff_Chang:array of byte;Send_len:byte):byte;
var
     len,i:byte;
     check_sum:byte;
     //testbuf:array[0..4] of byte;
begin
        len:=0;
        Compu_Check(mByteAry,Send_len,check_sum); //计算报文的校验位
        for i:=0 to Send_len do
        begin
              if mByteAry[i]=$7D then
              begin
                 len:=len+1;
                 Send_Buff_Chang[len]:=$0A;
              end
              else if  mByteAry[i]<$10 then
              begin
                   len:=len+1;
                   Send_Buff_Chang[len]:=$7D;
                   len:=len+1;
                   Send_Buff_Chang[len]:=mByteAry[i] xor $7D;
              end
              else begin
                   len:=len+1;
                   Send_Buff_Chang[len]:=mByteAry[i];
              end;
        end;

       len:=len+1;
       Send_Buff_Chang[len]:= check_sum;
       Send_Buff_Chang[0] := $0E;  //帧头
       len:=len+1;
       Send_Buff_Chang[len]:=$05;    //帧尾
end;

function DataChang(mIn_Buffer:array of byte;var outBuffer:array of byte;mIn_Count:byte):byte;
var
    i:byte;
    len:byte;
    flag_rec:byte;
begin
     len:=0;
     flag_rec:=0;
     for i:=0 to mIn_Count-1 do
     begin
         if flag_rec=1 then
         begin
              outBuffer[len]:=mIn_Buffer[i] xor $7d;
              Inc(len);
              flag_rec:=0;
              continue;
         end;
         case mIn_Buffer[i] of
         $0E:continue;
         $05:continue;
         $0A:
            begin
                outBuffer[len]:=$7D;
                Inc(len);
            end;
         $7D:flag_rec:=1;
         else
              begin
                       outBuffer[len]:= mIn_Buffer[i];
                       Inc(len);
              end;
         end;
    end;
    DataChang:=len;
end;

function EncryptStr(AStr:string):string;
begin
    Result := AStr;
end;

//这是一个将字符转换为相应的十六进制值的函数
//功能：若是在0-F之间的字符，则转换为相应的十六进制字符，否则返回-1
function ConvertHexChar(ch:byte):byte;
begin
	if   (ch>=byte('0')) and (ch <= byte('9')) then
        begin
	      	Result := ch - byte('0');
        end
	else if (ch >= byte('A')) and (ch <= byte('F')) then
        begin
		Result:=ch- byte('A')+10;
        end
	else if (ch>=byte('a')) and (ch<=byte('f')) then
        begin
		Result:=ch-byte('a')+10;
        end
	else
           begin
                Result := $ff;
           end;
end;

//将字符串转化为二进制数
function strTohex(str:string;var strHex:array of byte):integer;
var
     hexdata,lowhexdata:byte;
     hexdatalen:integer;
     len,i:byte;
     lstr,hstr:string;
     buffer:pchar;
     enduntil:Bool;
begin
	len:=Length(str);
	//for i:=0 to len-1 do
        i:=0;
        hexdatalen:=0;
        enduntil:=False;
	repeat
                hstr:= Copy(str,i,1);
		if hstr=' ' then
		begin
		        i:=i+1;
		       	continue;
		end;

		i:=i+1;
		hstr:=Copy(str,i,1);

                GetMem(Buffer,2);
                strcopy(buffer,pchar(hstr));
   	        hexdata:=ConvertHexChar(byte(buffer^));
                if hexdata=$ff then
                begin
                     Result:=-1;
                     break;
                end;
                FreeMem(Buffer);

                dec(len);
                if len=0 then
                begin
                      hexdata:=hexdata;
                      strHex[hexdatalen]:=byte(hexdata);
                      break;
                end;

                i:=i+1;
		lstr:=Copy(str,i,1);

                GetMem(Buffer,2);
                strcopy(buffer,pchar(lstr));
   	        lowhexdata:=ConvertHexChar(byte(buffer^));
                if hexdata=$ff then
                begin
                     Result:=-1;
                     break;
                end;
                FreeMem(Buffer);

		if (hexdata=16) or (lowhexdata=16) then
                begin
			break;
                end
		else
			hexdata:=hexdata*16+lowhexdata;

		strHex[hexdatalen]:=byte(hexdata);
		hexdatalen:=hexdatalen+1;

                dec(len);
                if len=0 then
                  enduntil:=true;
	until enduntil;
	Result:=hexdatalen;
end;
end.