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

📄 synachar.pas

📁 snmp设计增加相应SNMP的OID,是实时处理的.
💻 PAS
📖 第 1 页 / 共 5 页
字号:
      ul := BinToInt(s);
      w1 := ul div 65536;
      w2 := ul mod 65536;
      Result := Result + WriteMulti(Lo(w2), Hi(w2), Lo(w1), Hi(w1), 4, false);
    end;
  end;
end;

{==============================================================================}
function UCS4toUTF8(const Value: AnsiString): AnsiString;
var
  s, l, k: AnsiString;
  b1, b2, b3, b4: Byte;
  n, m, x, y: Integer;
  b: Byte;
begin
  Result := '';
  n := 1;
  while Length(Value) >= n do
  begin
    ReadMulti(Value, n, 4, b1, b2, b3, b4, false);
    if (b2 = 0) and (b3 = 0) and (b4 = 0) and (b1 < 128) then
      Result := Result + AnsiChar(b1)
    else
    begin
      x := (b1 + 256 * b2) + (b3 + 256 * b4) * 65536;
      l := IntToBin(x, 0);
      y := Length(l) div 6;
      s := '';
      for m := 1 to y do
      begin
        k := Copy(l, Length(l) - 5, 6);
        l := Copy(l, 1, Length(l) - 6);
        b := BinToInt(k) or $80;
        s := AnsiChar(b) + s;
      end;
      b := BinToInt(l);
      case y of
        5:
          b := b or $FC;
        4:
          b := b or $F8;
        3:
          b := b or $F0;
        2:
          b := b or $E0;
        1:
          b := b or $C0;
      end;
      s := AnsiChar(b) + s;
      Result := Result + s;
    end;
  end;
end;

{==============================================================================}
function UTF7toUCS2(const Value: AnsiString; Modified: Boolean): AnsiString;
var
  n, i: Integer;
  c: AnsiChar;
  s, t: AnsiString;
  shift: AnsiChar;
  table: String;
begin
  Result := '';
  n := 1;
  if modified then
  begin
    shift := '&';
    table := TableBase64mod;
  end
  else
  begin
    shift := '+';
    table := TableBase64;
  end;
  while Length(Value) >= n do
  begin
    c := Value[n];
    Inc(n);
    if c <> shift then
      Result := Result + WriteMulti(Ord(c), 0, 0, 0, 2, false)
    else
    begin
      s := '';
      while Length(Value) >= n do
      begin
        c := Value[n];
        Inc(n);
        if c = '-' then
          Break;
        if (c = '=') or (Pos(c, table) < 1) then
        begin
          Dec(n);
          Break;
        end;
        s := s + c;
      end;
      if s = '' then
        s := WriteMulti(Ord(shift), 0, 0, 0, 2, false)
      else
      begin
        if modified then
          t := DecodeBase64mod(s)
        else
          t := DecodeBase64(s);
        if not odd(length(t)) then
          s := t
        else
        begin //ill-formed sequence
          t := s;
          s := WriteMulti(Ord(shift), 0, 0, 0, 2, false);
          for i := 1 to length(t) do
            s := s + WriteMulti(Ord(t[i]), 0, 0, 0, 2, false);
        end;
      end;
      Result := Result + s;
    end;
  end;
end;

{==============================================================================}
function UCS2toUTF7(const Value: AnsiString; Modified: Boolean): AnsiString;
var
  s: AnsiString;
  b1, b2, b3, b4: Byte;
  n, m: Integer;
  shift: AnsiChar;
begin
  Result := '';
  n := 1;
  if modified then
    shift := '&'
  else
    shift := '+';
  while Length(Value) >= n do
  begin
    ReadMulti(Value, n, 2, b1, b2, b3, b4, false);
    if (b2 = 0) and (b1 < 128) then
      if AnsiChar(b1) = shift then
        Result := Result + shift + '-'
      else
        Result := Result + AnsiChar(b1)
    else
    begin
      s := AnsiChar(b2) + AnsiChar(b1);
      while Length(Value) >= n do
      begin
        ReadMulti(Value, n, 2, b1, b2, b3, b4, false);
        if (b2 = 0) and (b1 < 128) then
        begin
          Dec(n, 2);
          Break;
        end;
        s := s + AnsiChar(b2) + AnsiChar(b1);
      end;
      if modified then
        s := EncodeBase64mod(s)
      else
        s := EncodeBase64(s);
      m := Pos('=', s);
      if m > 0 then
        s := Copy(s, 1, m - 1);
      Result := Result + shift + s + '-';
    end;
  end;
end;

{==============================================================================}
function CharsetConversion(const Value: AnsiString; CharFrom: TMimeChar;
  CharTo: TMimeChar): AnsiString;
begin
  Result := CharsetConversionEx(Value, CharFrom, CharTo, Replace_None);
end;

{==============================================================================}
function CharsetConversionEx(const Value: AnsiString; CharFrom: TMimeChar;
  CharTo: TMimeChar; const TransformTable: array of Word): AnsiString;
begin
  Result := CharsetConversionTrans(Value, CharFrom, CharTo, TransformTable, True);
end;

{==============================================================================}
function CharsetConversionTrans(Value: AnsiString; CharFrom: TMimeChar;
  CharTo: TMimeChar; const TransformTable: array of Word; Translit: Boolean): AnsiString;
var
  uni: Word;
  n, m: Integer;
  b: Byte;
  b1, b2, b3, b4: Byte;
  SourceTable, TargetTable: array[128..255] of Word;
  mbf, mbt: Byte;
  lef, let: Boolean;
  ucsstring, s, t: AnsiString;
  cd: iconv_t;
  f: Boolean;
  NotNeedTransform: Boolean;
  FromID, ToID: string;
begin
  NotNeedTransform := (High(TransformTable) = 0);
  if (CharFrom = CharTo) and NotNeedTransform then
  begin
    Result := Value;
    Exit;
  end;
  FromID := GetIDFromCP(CharFrom);
  ToID := GetIDFromCP(CharTo);
  cd := Iconv_t(-1);
  //do two-pass conversion. Transform to UCS-2 first.
  if CharFrom = UCS_2 then
    ucsstring := Value
  else
  begin
    if not DisableIconv then
      cd := SynaIconvOpenIgnore('UCS-2BE', FromID);
    try
      if cd <> iconv_t(-1) then
        SynaIconv(cd, Value, ucsstring)
      else
      begin
        s := Value;
        if CharFrom = UTF_8 then
          s := UTF8toUCS4(Value)
        else
          if CharFrom = UTF_7 then
            s := UTF7toUCS2(Value, False)
          else
            if CharFrom = UTF_7mod then
              s := UTF7toUCS2(Value, True);
        GetArray(CharFrom, SourceTable);
        mbf := 1;
        if CharFrom in SetTwo then
          mbf := 2;
        if CharFrom in SetFour then
          mbf := 4;
        lef := CharFrom in SetLe;
        ucsstring := '';
        n := 1;
        while Length(s) >= n do
        begin
          ReadMulti(s, n, mbf, b1, b2, b3, b4, lef);
          //handle BOM
          if (b3 = 0) and (b4 = 0) then
          begin
            if (b1 = $FE) and (b2 = $FF) then
            begin
              lef := not lef;
              continue;
            end;
            if (b1 = $FF) and (b2 = $FE) then
              continue;
          end;
          if mbf = 1 then
            if b1 > 127 then
            begin
              uni := SourceTable[b1];
              b1 := Lo(uni);
              b2 := Hi(uni);
            end;
          ucsstring := ucsstring + WriteMulti(b1, b2, b3, b4, 2, False);
        end;
      end;
    finally
      SynaIconvClose(cd);
    end;
  end;
  //here we allways have ucstring with UCS-2 encoding
  //second pass... from UCS-2 to target encoding.
    if not DisableIconv then
      if translit then
        cd := SynaIconvOpenTranslit(ToID, 'UCS-2BE')
      else
        cd := SynaIconvOpenIgnore(ToID, 'UCS-2BE');
  try
    if (cd <> iconv_t(-1)) and NotNeedTransform then
    begin
      if CharTo = UTF_7 then
        ucsstring := ucsstring + #0 + '-';
      //when transformtable is not needed and Iconv know target charset,
      //do it fast by one call.
      SynaIconv(cd, ucsstring, Result);
      if CharTo = UTF_7 then
        Delete(Result, Length(Result), 1);
    end
    else
    begin
      GetArray(CharTo, TargetTable);
      mbt := 1;
      if CharTo in SetTwo then
        mbt := 2;
      if CharTo in SetFour then
        mbt := 4;
      let := CharTo in SetLe;
      b3 := 0;
      b4 := 0;
      Result := '';
      for n:= 0 to (Length(ucsstring) div 2) - 1 do
      begin
        s := Copy(ucsstring, n * 2 + 1, 2);
        b2 := Ord(s[1]);
        b1 := Ord(s[2]);
        uni := b2 * 256 + b1;
        if not NotNeedTransform then
        begin
          uni := ReplaceUnicode(uni, TransformTable);
          b1 := Lo(uni);
          b2 := Hi(uni);
          s[1] := AnsiChar(b2);
          s[2] := AnsiChar(b1);
        end;
        if cd <> iconv_t(-1) then
        begin
          if CharTo = UTF_7 then
            s := s + #0 + '-';
          SynaIconv(cd, s, t);
          if CharTo = UTF_7 then
            Delete(t, Length(t), 1);
          Result := Result + t;
        end
        else
        begin
          f := True;
          if mbt = 1 then
            if uni > 127 then
            begin
              f := False;
              b := 0;
              for m := 128 to 255 do
                if TargetTable[m] = uni then
                begin
                  b := m;
                  f := True;
                  Break;
                end;
              b1 := b;
              b2 := 0;
            end
            else
              b1 := Lo(uni);
          if not f then
            if translit then
            begin
              b1 := Ord(NotFoundChar);
              b2 := 0;
              f := True;
            end;
          if f then
            Result := Result + WriteMulti(b1, b2, b3, b4, mbt, let)
        end;
      end;
      if cd = iconv_t(-1) then
      begin
        if CharTo = UTF_7 then
          Result := UCS2toUTF7(Result, false);
        if CharTo = UTF_7mod then
          Result := UCS2toUTF7(Result, true);
        if CharTo = UTF_8 then
          Result := UCS4toUTF8(Result);
      end;
    end;
  finally
    SynaIconvClose(cd);
  end;
end;

{==============================================================================}

⌨️ 快捷键说明

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