synachar.pas

snmp设计增加相应SNMP的OID,是实时处理的.

    $044E, $0430, $0431, $0446, $0434, $0435, $0444, $0433,
    $0445, $0438, $0439, $043A, $043B, $043C, $043D, $043E,
    $043F, $044F, $0440, $0441, $0442, $0443, $0436, $0432,
    $044C, $044B, $0437, $0448, $044D, $0449, $0447, $044A,
    $042E, $0410, $0411, $0426, $0414, $0415, $0424, $0413,
    $0425, $0418, $0419, $041A, $041B, $041C, $041D, $041E,
    $041F, $042F, $0420, $0421, $0422, $0423, $0416, $0412,
    $042C, $042B, $0417, $0428, $042D, $0429, $0427, $042A
    );

{Czech (Kamenicky)
}
  CharCP_895: array[128..255] of Word =
  (
    $010C, $00FC, $00E9, $010F, $00E4, $010E, $0164, $010D,
    $011B, $011A, $0139, $00CD, $013E, $013A, $00C4, $00C1,
    $00C9, $017E, $017D, $00F4, $00F6, $00D3, $016F, $00DA,
    $00FD, $00D6, $00DC, $0160, $013D, $00DD, $0158, $0165,
    $00E1, $00ED, $00F3, $00FA, $0148, $0147, $016E, $00D4,
    $0161, $0159, $0155, $0154, $00BC, $00A7, $00AB, $00BB,
    $2591, $2592, $2593, $2502, $2524, $2561, $2562, $2556,
    $2555, $2563, $2551, $2557, $255D, $255C, $255B, $2510,
    $2514, $2534, $252C, $251C, $2500, $253C, $255E, $255F,
    $255A, $2554, $2569, $2566, $2560, $2550, $256C, $2567,
    $2568, $2564, $2565, $2559, $2558, $2552, $2553, $256B,
    $256A, $2518, $250C, $2588, $2584, $258C, $2590, $2580,
    $03B1, $03B2, $0393, $03C0, $03A3, $03C3, $03BC, $03C4,
    $03A6, $0398, $03A9, $03B4, $221E, $2205, $03B5, $2229,
    $2261, $00B1, $2265, $2264, $2320, $2321, $00F7, $2248,
    $2218, $00B7, $2219, $221A, $207F, $00B2, $25A0, $00A0
    );

{Eastern European
}
  CharCP_852: array[128..255] of Word =
  (
    $00C7, $00FC, $00E9, $00E2, $00E4, $016F, $0107, $00E7,
    $0142, $00EB, $0150, $0151, $00EE, $0179, $00C4, $0106,
    $00C9, $0139, $013A, $00F4, $00F6, $013D, $013E, $015A,
    $015B, $00D6, $00DC, $0164, $0165, $0141, $00D7, $010D,
    $00E1, $00ED, $00F3, $00FA, $0104, $0105, $017D, $017E,
    $0118, $0119, $00AC, $017A, $010C, $015F, $00AB, $00BB,
    $2591, $2592, $2593, $2502, $2524, $00C1, $00C2, $011A,
    $015E, $2563, $2551, $2557, $255D, $017B, $017C, $2510,
    $2514, $2534, $252C, $251C, $2500, $253C, $0102, $0103,
    $255A, $2554, $2569, $2566, $2560, $2550, $256C, $00A4,
    $0111, $0110, $010E, $00CB, $010F, $0147, $00CD, $00CE,
    $011B, $2518, $250C, $2588, $2584, $0162, $016E, $2580,
    $00D3, $00DF, $00D4, $0143, $0144, $0148, $0160, $0161,
    $0154, $00DA, $0155, $0170, $00FD, $00DD, $0163, $00B4,
    $00AD, $02DD, $02DB, $02C7, $02D8, $00A7, $00F7, $00B8,
    $00B0, $00A8, $02D9, $0171, $0158, $0159, $25A0, $00A0
    );

{==============================================================================}
type
  TIconvChar = record
    Charset: TMimeChar;
    CharName: string;
  end;
  TIconvArr = array [0..112] of TIconvChar;

const
  NotFoundChar = '_';

var
  SetTwo: set of TMimeChar = [UCS_2, UCS_2LE, UTF_7, UTF_7mod];
  SetFour: set of TMimeChar = [UCS_4, UCS_4LE, UTF_8];
  SetLE: set of TMimeChar = [UCS_2LE, UCS_4LE];

  IconvArr: TIconvArr;

{==============================================================================}
function FindIconvID(const Value, Charname: string): Boolean;
var
  s: string;
begin
  Result := True;
  //exact match
  if Value = Charname then
    Exit;
  //Value is on begin of charname
  s := Value + ' ';
  if s = Copy(Charname, 1, Length(s)) then
    Exit;
  //Value is on end of charname
  s := ' ' + Value;
  if s = Copy(Charname, Length(Charname) - Length(s) + 1, Length(s)) then
    Exit;
  //value is somewhere inside charname
  if Pos( s + ' ', Charname) > 0 then
    Exit;
  Result := False;
end;

function GetCPFromIconvID(Value: AnsiString): TMimeChar;
var
  n: integer;
begin
  Result := ISO_8859_1;
  Value := UpperCase(Value);
  for n := 0 to High(IconvArr) do
    if FindIconvID(Value, IconvArr[n].Charname) then
    begin
      Result := IconvArr[n].Charset;
      Break;
    end;
end;

{==============================================================================}
function GetIconvIDFromCP(Value: TMimeChar): AnsiString;
var
  n: integer;
begin
  Result := 'ISO-8859-1';
  for n := 0 to High(IconvArr) do
    if IconvArr[n].Charset = Value then
    begin
      Result := Separateleft(IconvArr[n].Charname, ' ');
      Break;
    end;
end;

{==============================================================================}
function ReplaceUnicode(Value: Word; const TransformTable: array of Word): Word;
var
  n: integer;
begin
  if High(TransformTable) <> 0 then
    for n := 0 to High(TransformTable) do
      if not odd(n) then
        if TransformTable[n] = Value then
          begin
            Value := TransformTable[n+1];
            break;
          end;
  Result := Value;
end;

{==============================================================================}
procedure CopyArray(const SourceTable: array of Word;
  var TargetTable: array of Word);
var
  n: Integer;
begin
  for n := 0 to 127 do
    TargetTable[n] := SourceTable[n];
end;

{==============================================================================}
procedure GetArray(CharSet: TMimeChar; var Result: array of Word);
begin
  case CharSet of
    ISO_8859_2:
      CopyArray(CharISO_8859_2, Result);
    ISO_8859_3:
      CopyArray(CharISO_8859_3, Result);
    ISO_8859_4:
      CopyArray(CharISO_8859_4, Result);
    ISO_8859_5:
      CopyArray(CharISO_8859_5, Result);
    ISO_8859_6:
      CopyArray(CharISO_8859_6, Result);
    ISO_8859_7:
      CopyArray(CharISO_8859_7, Result);
    ISO_8859_8:
      CopyArray(CharISO_8859_8, Result);
    ISO_8859_9:
      CopyArray(CharISO_8859_9, Result);
    ISO_8859_10:
      CopyArray(CharISO_8859_10, Result);
    ISO_8859_13:
      CopyArray(CharISO_8859_13, Result);
    ISO_8859_14:
      CopyArray(CharISO_8859_14, Result);
    ISO_8859_15:
      CopyArray(CharISO_8859_15, Result);
    CP1250:
      CopyArray(CharCP_1250, Result);
    CP1251:
      CopyArray(CharCP_1251, Result);
    CP1252:
      CopyArray(CharCP_1252, Result);
    CP1253:
      CopyArray(CharCP_1253, Result);
    CP1254:
      CopyArray(CharCP_1254, Result);
    CP1255:
      CopyArray(CharCP_1255, Result);
    CP1256:
      CopyArray(CharCP_1256, Result);
    CP1257:
      CopyArray(CharCP_1257, Result);
    CP1258:
      CopyArray(CharCP_1258, Result);
    KOI8_R:
      CopyArray(CharKOI8_R, Result);
    CP895:
      CopyArray(CharCP_895, Result);
    CP852:
      CopyArray(CharCP_852, Result);
  else
      CopyArray(CharISO_8859_1, Result);
  end;
end;

{==============================================================================}
procedure ReadMulti(const Value: AnsiString; var Index: Integer; mb: Byte;
  var b1, b2, b3, b4: Byte; le: boolean);
Begin
  b1 := 0;
  b2 := 0;
  b3 := 0;
  b4 := 0;
  if Index < 0 then
    Index := 1;
  if mb > 4 then
    mb := 1;
  if (Index + mb - 1) <= Length(Value) then
  begin
    if le then
      Case mb Of
        1:
          b1 := Ord(Value[Index]);
        2:
          Begin
            b1 := Ord(Value[Index]);
            b2 := Ord(Value[Index + 1]);
          End;
        3:
          Begin
            b1 := Ord(Value[Index]);
            b2 := Ord(Value[Index + 1]);
            b3 := Ord(Value[Index + 2]);
          End;
        4:
          Begin
            b1 := Ord(Value[Index]);
            b2 := Ord(Value[Index + 1]);
            b3 := Ord(Value[Index + 2]);
            b4 := Ord(Value[Index + 3]);
          End;
      end
    else
      Case mb Of
        1:
          b1 := Ord(Value[Index]);
        2:
          Begin
            b2 := Ord(Value[Index]);
            b1 := Ord(Value[Index + 1]);
          End;
        3:
          Begin
            b3 := Ord(Value[Index]);
            b2 := Ord(Value[Index + 1]);
            b1 := Ord(Value[Index + 2]);
          End;
        4:
          Begin
            b4 := Ord(Value[Index]);
            b3 := Ord(Value[Index + 1]);
            b2 := Ord(Value[Index + 2]);
            b1 := Ord(Value[Index + 3]);
          End;
      end;
    Inc(Index, mb);
  End;
End;

{==============================================================================}
function WriteMulti(b1, b2, b3, b4: Byte; mb: Byte; le: boolean): AnsiString;
begin
  if mb > 4 then
    mb := 1;
  SetLength(Result, mb);
  if le then
    case mb Of
      1:
        Result[1] := AnsiChar(b1);
      2:
        begin
          Result[1] := AnsiChar(b1);
          Result[2] := AnsiChar(b2);
        end;
      3:
        begin
          Result[1] := AnsiChar(b1);
          Result[2] := AnsiChar(b2);
          Result[3] := AnsiChar(b3);
        end;
      4:
        begin
          Result[1] := AnsiChar(b1);
          Result[2] := AnsiChar(b2);
          Result[3] := AnsiChar(b3);
          Result[4] := AnsiChar(b4);
        end;
    end
  else
    case mb Of
      1:
        Result[1] := AnsiChar(b1);
      2:
        begin
          Result[2] := AnsiChar(b1);
          Result[1] := AnsiChar(b2);
        end;
      3:
        begin
          Result[3] := AnsiChar(b1);
          Result[2] := AnsiChar(b2);
          Result[1] := AnsiChar(b3);
        end;
      4:
        begin
          Result[4] := AnsiChar(b1);
          Result[3] := AnsiChar(b2);
          Result[2] := AnsiChar(b3);
          Result[1] := AnsiChar(b4);
        end;
    end;
end;

{==============================================================================}
function UTF8toUCS4(const Value: AnsiString): AnsiString;
var
  n, x, ul, m: Integer;
  s: AnsiString;
  w1, w2: Word;
begin
  Result := '';
  n := 1;
  while Length(Value) >= n do
  begin
    x := Ord(Value[n]);
    Inc(n);
    if x < 128 then
      Result := Result + WriteMulti(x, 0, 0, 0, 4, false)
    else
    begin
      m := 0;
      if (x and $E0) = $C0 then
        m := $1F;
      if (x and $F0) = $E0 then
        m := $0F;
      if (x and $F8) = $F0 then
        m := $07;
      if (x and $FC) = $F8 then
        m := $03;
      if (x and $FE) = $FC then
        m := $01;
      ul := x and m;
      s := IntToBin(ul, 0);
      while Length(Value) >= n do
      begin
        x := Ord(Value[n]);
        Inc(n);
        if (x and $C0) = $80 then
          s := s + IntToBin(x and $3F, 6)
        else
        begin
          Dec(n);
          Break;
        end;
      end;