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

📄 cmpp.pas

📁 cmpp协议的delphi解析cmpp协议的点歌系统
💻 PAS
字号:
unit cmpp;

interface

Uses
    CMPP_Protocol,SysUtils,Windows;

Type
  FileRec = Record
    s_funcname:string;
    s_oper:string;      //什么操作
    s_result:string;    //操作结果
    s_errcode:string;   //错误代码
    s_err:string;    //错误描述
    s_time:string;
  end;
  function WriteLog():boolean;
  function BinToInt(Value: string): Tulargeinteger;
  function IntToBin(Value: Longint; Digits: Integer): string;
  function BToI(Value: string): Integer;
  function IntToBin64(Value: int64; Digits: Integer): string;
  function Create_msg_id:Tulargeinteger;
  function LAddChar(Value: string;len:integer): string;
var
   LogRec:FileRec;
   msg_time:string;  //msg_id中包括的时间
   msg_sn:integer;    //msg_id中包括的序号
   msg_gateway:string; //msg_id中包括的网关代码

implementation

function WriteLog():boolean;
var
  filehandle, i: Integer;
   MyTxt: TextFile;
   s,s1:string;

begin
//   if not FileExists('.\error.log') then       //创建文件

   s1:=LAddChar(logrec.s_funcname,18);
   s:=s+s1;
   s1:=LAddChar(logrec.s_oper,50);
   s:=s+s1;
   s1:=LAddChar(logrec.s_result,5);
   s:=s+s1;
   s1:=LAddChar(logrec.s_errcode,7);
   s:=s+s1;
   s1:=LAddChar(logrec.s_err,20);
   s:=s+s1;
   s1:=LAddChar(logrec.s_time,20);
   s:=s+s1;

   try
    if FileExists('.\error.log') then
    begin
      AssignFile(MyTxt,'.\error.log');
      Append(MyTxt);
      writeln(MyTxt,s);
    end
   finally
      LogRec.s_time:='';
      CloseFile(MyTxt);
    end;
  {
  try
      if FileExists('.\error.log') then       //创建文件
        filehandle := FileOpen('.\error.log', fmOpenReadWrite)
      else
      begin
        filehandle := FileCreate('.\error.log');
        if not (filehandle<0) then
        begin
          LogRec.s_funcname := '函数名';
          LogRec.s_oper := '操作名';
          LogRec.s_result := '操作结果';
          LogRec.s_errcode := '错误代码';
          LogRec.s_err := '错误原因';
          LogRec.s_time := '日期/时间';
          FileWrite(filehandle, LogRec, SizeOf(LogRec));  //写文件
          //Writeln(filehandle, LogRec, SizeOf(LogRec));  //写文件

          FileClose(filehandle);
          exit;
        end;
      end;

      if (filehandle < 0 ) then
        exit;

    //FileSeek(filehandle, 0, 0);           //查找文件的开头
      FileWrite(filehandle, LogRec, SizeOf(LogRec));  //写文件
      LogRec.s_time:='';
  finally
    FileClose(filehandle);
  end;
  }
end;

function BinToInt(Value: string): Tulargeinteger;
var
    i, iValueSize: Integer;
    value1:string;
    value2:string;
begin
    Result.HighPart  := 0;
    Result.LowPart   := 0;

    value1:=copy(value,1,32);
    value2:=copy(value,33,32);

    iValueSize:=32;

    for i := iValueSize downto 1 do
        if Value1[i] = '1' then Result.HighPart   := Result.HighPart   + (1 shl (iValueSize - i));

    for i := iValueSize downto 1 do
        if Value2[i] = '1' then Result.LowPart   := Result.LowPart   + (1 shl (iValueSize - i));

end;


//十进制到二进制
function IntToBin(Value: Longint; Digits: Integer): string;
var
    i: Integer;
begin
    Result := '';
    for i := Digits downto 0 do
        if Value and (1 shl i) <> 0 then
            Result := Result + '1'
        else
            Result := Result + '0';
end;

function IntToBin64(Value: int64; Digits: Integer): string;
var
    i: integer;
begin
    Result := '';
    for i := Digits downto 0 do
        if Value and (1 shl i) <> 0 then
            Result := Result + '1'
        else
            Result := Result + '0';
end;

function BToI(Value: string): Integer;
var
  i, iValueSize: Integer;
begin
    Result := 0;
    iValueSize := Length(Value);
    for i := iValueSize downto 1 do
      if Value[i] = '1' then Result := Result + (1 shl (iValueSize - i));
end;

function LAddChar(Value: string;len:integer): string;
var
  i,iLen:integer;
  s_value:string;
begin
  iLen:=length(Value);

  s_value:='';
  
  if len<iLen then
  begin
    result:=Copy(Value, 1, len);
    exit;
  end;

  s_value:=value;

  for i := iLen+1 to len do
      s_value:=s_value+' ';

  result:=s_value;
end;

function  Create_msg_id:Tulargeinteger;
var
   s_time:string;
   s_month:string;
   s_day:string;
   s_hour:string;
   s_min:string;
   s_sec:string;
   s_gateway:string;
   s_sn:string;
   s_msg_id:string;
   li1:int64;
   li2:int64;

   hstr1:string;
   hstr2:string;
   hstr3:string;
   hstr4:string;

   lstr1:string;
   lstr2:string;
   lstr3:string;
   lstr4:string;
begin
   s_time:=FormatDateTime('yyyy-mm-dd hh:mm:ss',now);

   //if s_time=msg_time then
   //     msg_sn:=msg_sn+1
   //else
   //    msg_sn:=1;
   if msg_sn=65535 then
      msg_sn:=1
   else
      msg_sn:=msg_sn+1;

   msg_time:=s_time;

   s_month:=IntToBin(strtoint(copy(s_time,6,2)),3);
   s_day:=IntToBin(strtoint(copy(s_time,9,2)),4);
   s_hour:=IntToBin(strtoint(copy(s_time,12,2)),4);
   s_min:=IntToBin(strtoint(copy(s_time,15,2)),5);
   s_sec:=IntToBin(strtoint(copy(s_time,18,2)),5);

   s_gateway:=IntToBin(strtoint(msg_gateway),21);
   s_sn:=IntToBin(msg_sn,15);

   s_msg_id:=s_month+s_day+s_hour+s_min+s_sec+s_gateway+s_sn;

   hstr1:=copy(s_msg_id,1,8);
   hstr2:=copy(s_msg_id,9,8);
   hstr3:=copy(s_msg_id,17,8);
   hstr4:=copy(s_msg_id,25,8);

   lstr1:=copy(s_msg_id,33,8);
   lstr2:=copy(s_msg_id,41,8);
   lstr3:=copy(s_msg_id,49,8);
   lstr4:=copy(s_msg_id,57,8);

   s_msg_id:=hstr4+hstr3+hstr2+hstr1+lstr4+lstr3+lstr2+lstr1;
   result:=BinToInt(s_msg_id);

{
4(64-61):月份
5(60-56):日
5(55-51):小时
6(50-45):分
6(44-39):秒

22(38-17):网关代码
16(16-1):序列号
}
end;

end.

⌨️ 快捷键说明

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