| 18,7 → 18,7 |
|---|
| function CompareOID(a, b: string): integer; |
| procedure ListBubbleSortOID(list: PStringList); |
| function ASN1IDValid(asn1id: string): boolean; |
| function UnicodeLabelValid(unicodeLabel: string): boolean; |
| function UnicodeLabelValid(arc: string): boolean; |
| |
| implementation |
| |
| 129,77 → 129,89 |
|---|
| ASN1IDValid := true; |
| end; |
| |
| function UnicodeLabelValid(unicodeLabel: string): boolean; |
| (* Note: Since this is DOS, we don't support Unicode, so we just check *) |
| (* for Latin characters in the Unicode Label *) |
| function IriCharValid(c: char; firstchar, lastchar: boolean): boolean; |
| begin |
| UnicodeLabelValid := true; |
| (* TODO: Implement *) |
| (* see Rec. ITU-T X.660, clause 7.5 *) |
| |
| (* |
| if ((firstchar or lastchar) and (c = '-')) then |
| begin |
| IriCharValid := false; |
| Exit; |
| end; |
| |
| if (c in ['-', '.', '_', '~']) then |
| begin |
| IriCharValid := true; |
| Exit; |
| end; |
| |
| function iri_char_valid($c, $firstchar, $lastchar) { |
| // see Rec. ITU-T X.660, clause 7.5 |
| if ((c in ['0'..'9']) and not firstchar) or |
| (c in ['A'..'Z']) or |
| (c in ['a'..'z']) then |
| begin |
| IriCharValid := true; |
| Exit; |
| end; |
| |
| if (($firstchar || $lastchar) && ($c == '-')) return false; |
| (* |
| v = mb_ord(c); |
| if ((v >= 0x000000A0) && (v <= 0x0000DFFE)) return true; |
| if ((v >= 0x0000F900) && (v <= 0x0000FDCF)) return true; |
| if ((v >= 0x0000FDF0) && (v <= 0x0000FFEF)) return true; |
| if ((v >= 0x00010000) && (v <= 0x0001FFFD)) return true; |
| if ((v >= 0x00020000) && (v <= 0x0002FFFD)) return true; |
| if ((v >= 0x00030000) && (v <= 0x0003FFFD)) return true; |
| if ((v >= 0x00040000) && (v <= 0x0004FFFD)) return true; |
| if ((v >= 0x00050000) && (v <= 0x0005FFFD)) return true; |
| if ((v >= 0x00060000) && (v <= 0x0006FFFD)) return true; |
| if ((v >= 0x00070000) && (v <= 0x0007FFFD)) return true; |
| if ((v >= 0x00080000) && (v <= 0x0008FFFD)) return true; |
| if ((v >= 0x00090000) && (v <= 0x0009FFFD)) return true; |
| if ((v >= 0x000A0000) && (v <= 0x000AFFFD)) return true; |
| if ((v >= 0x000B0000) && (v <= 0x000BFFFD)) return true; |
| if ((v >= 0x000C0000) && (v <= 0x000CFFFD)) return true; |
| if ((v >= 0x000D0000) && (v <= 0x000DFFFD)) return true; |
| if ((v >= 0x000E1000) && (v <= 0x000EFFFD)) return true; |
| *) |
| |
| if ($c == '-') return true; |
| if ($c == '.') return true; |
| if ($c == '_') return true; |
| if ($c == '~') return true; |
| if (($c >= '0') && ($c <= '9') && (!$firstchar)) return true; |
| if (($c >= 'A') && ($c <= 'Z')) return true; |
| if (($c >= 'a') && ($c <= 'z')) return true; |
| (* Note: Rec. ITU-T X.660, clause 7.5.3 would also forbid ranges which are marked *) |
| (* in ISO/IEC 10646 as "(This position shall not be used)" *) |
| (* But tool implementers should be tolerate them, since these limitations can be removed in future. *) |
| |
| $v = mb_ord($c); |
| IriCharValid := false; |
| end; |
| |
| if (($v >= 0x000000A0) && ($v <= 0x0000DFFE)) return true; |
| if (($v >= 0x0000F900) && ($v <= 0x0000FDCF)) return true; |
| if (($v >= 0x0000FDF0) && ($v <= 0x0000FFEF)) return true; |
| if (($v >= 0x00010000) && ($v <= 0x0001FFFD)) return true; |
| if (($v >= 0x00020000) && ($v <= 0x0002FFFD)) return true; |
| if (($v >= 0x00030000) && ($v <= 0x0003FFFD)) return true; |
| if (($v >= 0x00040000) && ($v <= 0x0004FFFD)) return true; |
| if (($v >= 0x00050000) && ($v <= 0x0005FFFD)) return true; |
| if (($v >= 0x00060000) && ($v <= 0x0006FFFD)) return true; |
| if (($v >= 0x00070000) && ($v <= 0x0007FFFD)) return true; |
| if (($v >= 0x00080000) && ($v <= 0x0008FFFD)) return true; |
| if (($v >= 0x00090000) && ($v <= 0x0009FFFD)) return true; |
| if (($v >= 0x000A0000) && ($v <= 0x000AFFFD)) return true; |
| if (($v >= 0x000B0000) && ($v <= 0x000BFFFD)) return true; |
| if (($v >= 0x000C0000) && ($v <= 0x000CFFFD)) return true; |
| if (($v >= 0x000D0000) && ($v <= 0x000DFFFD)) return true; |
| if (($v >= 0x000E1000) && ($v <= 0x000EFFFD)) return true; |
| function UnicodeLabelValid(arc: string): boolean; |
| var |
| i: integer; |
| firstchar, lastchar: boolean; |
| begin |
| if arc = '' then |
| begin |
| UnicodeLabelValid := false; |
| Exit; |
| end; |
| |
| // Note: Rec. ITU-T X.660, clause 7.5.3 would also forbid ranges which are marked |
| // in ISO/IEC 10646 as "(This position shall not be used)" |
| // But tool implementers should be tolerate them, since these limitations can be removed in future. |
| if (Copy(arc, 3, 2) = '--') then (* see Rec. ITU-T X.660, clause 7.5.4 *) |
| begin |
| UnicodeLabelValid := false; |
| Exit; |
| end; |
| |
| return false; |
| } |
| for i := 1 to Length(arc) do |
| begin |
| firstchar := i = 1; |
| lastchar := i = Length(arc); |
| if not IriCharValid(arc[i], firstchar, lastchar) then |
| begin |
| UnicodeLabelValid := false; |
| Exit; |
| end; |
| end; |
| |
| function iri_arc_valid($arc, $allow_numeric=true) { |
| if ($arc == '') return false; |
| |
| $m = array(); |
| if ($allow_numeric && preg_match('@^(\\d+)$@', $arc, $m)) return true; # numeric arc |
| |
| // Question: Should we strip RTL/LTR characters? |
| |
| if (mb_substr($arc, 2, 2) == '--') return false; // see Rec. ITU-T X.660, clause 7.5.4 |
| |
| $array = array(); |
| preg_match_all('/./u', $arc, $array, PREG_SET_ORDER); |
| $len = count($array); |
| foreach ($array as $i => $char) { |
| if (!iri_char_valid($char[0], $i==0, $i==$len-1)) return false; |
| } |
| |
| return true; |
| } |
| |
| |
| *) |
| |
| UnicodeLabelValid := true; |
| end; |
| |
| end. |