Release 12
git-svn-id: https://svn.code.sf.net/p/synalist/code/trunk@27 7c85be65-684b-0410-a082-b2ed4fbef004
This commit is contained in:
geby
@@ -22,7 +22,7 @@
|
||||
| Hernan Sanchez (hernan.sanchez@iname.com) |
|
||||
|==============================================================================|
|
||||
| History: see HISTORY.HTM from distribution package |
|
||||
| (Found at URL: http://www.mlp.cz/space/gebauerl/synapse/) |
|
||||
| (Found at URL: http://www.ararat.cz/synapse/) |
|
||||
|==============================================================================}
|
||||
|
||||
unit ASN1Util;
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
| Contributor(s): |
|
||||
|==============================================================================|
|
||||
| History: see HISTORY.HTM from distribution package |
|
||||
| (Found at URL: http://www.mlp.cz/space/gebauerl/synapse/) |
|
||||
| (Found at URL: http://www.ararat.cz/synapse/) |
|
||||
|==============================================================================}
|
||||
|
||||
{
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
| Contributor(s): |
|
||||
|==============================================================================|
|
||||
| History: see HISTORY.HTM from distribution package |
|
||||
| (Found at URL: http://www.mlp.cz/space/gebauerl/synapse/) |
|
||||
| (Found at URL: http://www.ararat.cz/synapse/) |
|
||||
|==============================================================================}
|
||||
|
||||
unit blcksock;
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
| Contributor(s): |
|
||||
|==============================================================================|
|
||||
| History: see HISTORY.HTM from distribution package |
|
||||
| (Found at URL: http://www.mlp.cz/space/gebauerl/synapse/) |
|
||||
| (Found at URL: http://www.ararat.cz/synapse/) |
|
||||
|==============================================================================}
|
||||
|
||||
//RFC-1035, RFC-1183, RFC1706, RFC1712, RFC2163, RFC2230
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
| Contributor(s): |
|
||||
|==============================================================================|
|
||||
| History: see HISTORY.HTM from distribution package |
|
||||
| (Found at URL: http://www.mlp.cz/space/gebauerl/synapse/) |
|
||||
| (Found at URL: http://www.ararat.cz/synapse/) |
|
||||
|==============================================================================}
|
||||
|
||||
unit HTTPsend;
|
||||
|
||||
797
mimechar.pas
Normal file
797
mimechar.pas
Normal file
@@ -0,0 +1,797 @@
|
||||
{==============================================================================|
|
||||
| Project : Delphree - Synapse | 001.000.000 |
|
||||
|==============================================================================|
|
||||
| Content: MIME support character conversion tables
|
||||
|
|
||||
|==============================================================================|
|
||||
| The contents of this file are subject to the Mozilla Public License Ver. 1.0 |
|
||||
| (the "License"); you may not use this file except in compliance with the |
|
||||
| License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ |
|
||||
| |
|
||||
| Software distributed under the License is distributed on an "AS IS" basis, |
|
||||
| WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for |
|
||||
| the specific language governing rights and limitations under the License. |
|
||||
|==============================================================================|
|
||||
| The Original Code is Synapse Delphi Library. |
|
||||
|==============================================================================|
|
||||
| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
|
||||
| Portions created by Lukas Gebauer are Copyright (c)2000. |
|
||||
| All Rights Reserved. |
|
||||
|==============================================================================|
|
||||
| Contributor(s): |
|
||||
|==============================================================================|
|
||||
| History: see HISTORY.HTM from distribution package |
|
||||
| (Found at URL: http://www.ararat.cz/synapse/) |
|
||||
|==============================================================================}
|
||||
|
||||
unit MIMEchar;
|
||||
|
||||
interface
|
||||
|
||||
type
|
||||
|
||||
TMimeChar=(
|
||||
ISO_8859_1,
|
||||
ISO_8859_2,
|
||||
ISO_8859_3,
|
||||
ISO_8859_4,
|
||||
ISO_8859_5,
|
||||
ISO_8859_6,
|
||||
ISO_8859_7,
|
||||
ISO_8859_8,
|
||||
ISO_8859_9,
|
||||
ISO_8859_10,
|
||||
CP1250,
|
||||
CP1251,
|
||||
CP1252,
|
||||
CP1253,
|
||||
CP1254,
|
||||
CP1255,
|
||||
CP1256,
|
||||
CP1257,
|
||||
CP1258
|
||||
);
|
||||
|
||||
TSetChar=set of TMimeChar;
|
||||
|
||||
const
|
||||
|
||||
NotFoundChar='_';
|
||||
|
||||
{
|
||||
//dummy table
|
||||
$0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087,
|
||||
$0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
|
||||
$0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097,
|
||||
$0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
|
||||
$00A0, $00A1, $00A2, $00A3, $00A4, $00A5, $00A6, $00A7,
|
||||
$00A8, $00A9, $00AA, $00AB, $00AC, $00AD, $00AE, $00AF,
|
||||
$00B0, $00B1, $00B2, $00B3, $00B4, $00B5, $00B6, $00B7,
|
||||
$00B8, $00B9, $00BA, $00BB, $00BC, $00BD, $00BE, $00BF,
|
||||
$00C0, $00C1, $00C2, $00C3, $00C4, $00C5, $00C6, $00C7,
|
||||
$00C8, $00C9, $00CA, $00CB, $00CC, $00CD, $00CE, $00CF,
|
||||
$00D0, $00D1, $00D2, $00D3, $00D4, $00D5, $00D6, $00D7,
|
||||
$00D8, $00D9, $00DA, $00DB, $00DC, $00DD, $00DE, $00DF,
|
||||
$00E0, $00E1, $00E2, $00E3, $00E4, $00E5, $00E6, $00E7,
|
||||
$00E8, $00E9, $00EA, $00EB, $00EC, $00ED, $00EE, $00EF,
|
||||
$00F0, $00F1, $00F2, $00F3, $00F4, $00F5, $00F6, $00F7,
|
||||
$00F8, $00F9, $00FA, $00FB, $00FC, $00FD, $00FE, $00FF
|
||||
}
|
||||
|
||||
{Latin-1
|
||||
Danish, Dutch, English, Faeroese, Finnish, French, German, Icelandic, Irish,
|
||||
Italian, Norwegian, Portuguese, Spanish and Swedish.
|
||||
}
|
||||
CharISO_8859_1:array [128..255] of word =
|
||||
(
|
||||
$0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087,
|
||||
$0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
|
||||
$0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097,
|
||||
$0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
|
||||
$00A0, $00A1, $00A2, $00A3, $00A4, $00A5, $00A6, $00A7,
|
||||
$00A8, $00A9, $00AA, $00AB, $00AC, $00AD, $00AE, $00AF,
|
||||
$00B0, $00B1, $00B2, $00B3, $00B4, $00B5, $00B6, $00B7,
|
||||
$00B8, $00B9, $00BA, $00BB, $00BC, $00BD, $00BE, $00BF,
|
||||
$00C0, $00C1, $00C2, $00C3, $00C4, $00C5, $00C6, $00C7,
|
||||
$00C8, $00C9, $00CA, $00CB, $00CC, $00CD, $00CE, $00CF,
|
||||
$00D0, $00D1, $00D2, $00D3, $00D4, $00D5, $00D6, $00D7,
|
||||
$00D8, $00D9, $00DA, $00DB, $00DC, $00DD, $00DE, $00DF,
|
||||
$00E0, $00E1, $00E2, $00E3, $00E4, $00E5, $00E6, $00E7,
|
||||
$00E8, $00E9, $00EA, $00EB, $00EC, $00ED, $00EE, $00EF,
|
||||
$00F0, $00F1, $00F2, $00F3, $00F4, $00F5, $00F6, $00F7,
|
||||
$00F8, $00F9, $00FA, $00FB, $00FC, $00FD, $00FE, $00FF
|
||||
);
|
||||
|
||||
{Latin-2
|
||||
Albanian, Czech, English, German, Hungarian, Polish, Rumanian, Serbo-Croatian,
|
||||
Slovak, Slovene and Swedish.
|
||||
}
|
||||
CharISO_8859_2:array [128..255] of word =
|
||||
(
|
||||
$0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087,
|
||||
$0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
|
||||
$0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097,
|
||||
$0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
|
||||
$00a0, $0104, $02d8, $0141, $00a4, $013d, $015a, $00a7,
|
||||
$00a8, $0160, $015e, $0164, $0179, $00ad, $017d, $017b,
|
||||
$00b0, $0105, $02db, $0142, $00b4, $013e, $015b, $02c7,
|
||||
$00b8, $0161, $015f, $0165, $017a, $02dd, $017e, $017c,
|
||||
$0154, $00c1, $00c2, $0102, $00c4, $0139, $0106, $00c7,
|
||||
$010c, $00c9, $0118, $00cb, $011a, $00cd, $00ce, $010e,
|
||||
$0110, $0143, $0147, $00d3, $00d4, $0150, $00d6, $00d7,
|
||||
$0158, $016e, $00da, $0170, $00dc, $00dd, $0162, $00df,
|
||||
$0155, $00e1, $00e2, $0103, $00e4, $013a, $0107, $00e7,
|
||||
$010d, $00e9, $0119, $00eb, $011b, $00ed, $00ee, $010f,
|
||||
$0111, $0144, $0148, $00f3, $00f4, $0151, $00f6, $00f7,
|
||||
$0159, $016f, $00fa, $0171, $00fc, $00fd, $0163, $02d9
|
||||
);
|
||||
|
||||
{Latin-3
|
||||
Afrikaans, Catalan, English, Esperanto, French, Galician, German, Italian,
|
||||
Maltese and Turkish.
|
||||
}
|
||||
CharISO_8859_3:array [128..255] of word =
|
||||
(
|
||||
$0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087,
|
||||
$0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
|
||||
$0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097,
|
||||
$0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
|
||||
$00a0, $0126, $02d8, $00a3, $00a4, $fffd, $0124, $00a7,
|
||||
$00a8, $0130, $015e, $011e, $0134, $00ad, $fffd, $017b,
|
||||
$00b0, $0127, $00b2, $00b3, $00b4, $00b5, $0125, $00b7,
|
||||
$00b8, $0131, $015f, $011f, $0135, $00bd, $fffd, $017c,
|
||||
$00c0, $00c1, $00c2, $fffd, $00c4, $010a, $0108, $00c7,
|
||||
$00c8, $00c9, $00ca, $00cb, $00cc, $00cd, $00ce, $00cf,
|
||||
$fffd, $00d1, $00d2, $00d3, $00d4, $0120, $00d6, $00d7,
|
||||
$011c, $00d9, $00da, $00db, $00dc, $016c, $015c, $00df,
|
||||
$00e0, $00e1, $00e2, $fffd, $00e4, $010b, $0109, $00e7,
|
||||
$00e8, $00e9, $00ea, $00eb, $00ec, $00ed, $00ee, $00ef,
|
||||
$fffd, $00f1, $00f2, $00f3, $00f4, $0121, $00f6, $00f7,
|
||||
$011d, $00f9, $00fa, $00fb, $00fc, $016d, $015d, $02d9
|
||||
);
|
||||
|
||||
{Latin-4
|
||||
Danish, English, Estonian, Finnish, German, Greenlandic, Lappish, Latvian,
|
||||
Lithuanian, Norwegian and Swedish.
|
||||
}
|
||||
CharISO_8859_4:array [128..255] of word =
|
||||
(
|
||||
$0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087,
|
||||
$0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
|
||||
$0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097,
|
||||
$0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
|
||||
$00a0, $0104, $0138, $0156, $00a4, $0128, $013b, $00a7,
|
||||
$00a8, $0160, $0112, $0122, $0166, $00ad, $017d, $00af,
|
||||
$00b0, $0105, $02db, $0157, $00b4, $0129, $013c, $02c7,
|
||||
$00b8, $0161, $0113, $0123, $0167, $014a, $017e, $014b,
|
||||
$0100, $00c1, $00c2, $00c3, $00c4, $00c5, $00c6, $012e,
|
||||
$010c, $00c9, $0118, $00cb, $0116, $00cd, $00ce, $012a,
|
||||
$0110, $0145, $014c, $0136, $00d4, $00d5, $00d6, $00d7,
|
||||
$00d8, $0172, $00da, $00db, $00dc, $0168, $016a, $00df,
|
||||
$0101, $00e1, $00e2, $00e3, $00e4, $00e5, $00e6, $012f,
|
||||
$010d, $00e9, $0119, $00eb, $0117, $00ed, $00ee, $012b,
|
||||
$0111, $0146, $014d, $0137, $00f4, $00f5, $00f6, $00f7,
|
||||
$00f8, $0173, $00fa, $00fb, $00fc, $0169, $016b, $02d9
|
||||
);
|
||||
|
||||
{CYRILLIC
|
||||
Bulgarian, Bielorussian, English, Macedonian, Russian, Serbo-Croatian
|
||||
and Ukrainian.
|
||||
}
|
||||
CharISO_8859_5:array [128..255] of word =
|
||||
(
|
||||
$0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087,
|
||||
$0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
|
||||
$0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097,
|
||||
$0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
|
||||
$00a0, $0401, $0402, $0403, $0404, $0405, $0406, $0407,
|
||||
$0408, $0409, $040a, $040b, $040c, $00ad, $040e, $040f,
|
||||
$0410, $0411, $0412, $0413, $0414, $0415, $0416, $0417,
|
||||
$0418, $0419, $041a, $041b, $041c, $041d, $041e, $041f,
|
||||
$0420, $0421, $0422, $0423, $0424, $0425, $0426, $0427,
|
||||
$0428, $0429, $042a, $042b, $042c, $042d, $042e, $042f,
|
||||
$0430, $0431, $0432, $0433, $0434, $0435, $0436, $0437,
|
||||
$0438, $0439, $043a, $043b, $043c, $043d, $043e, $043f,
|
||||
$0440, $0441, $0442, $0443, $0444, $0445, $0446, $0447,
|
||||
$0448, $0449, $044a, $044b, $044c, $044d, $044e, $044f,
|
||||
$2116, $0451, $0452, $0453, $0454, $0455, $0456, $0457,
|
||||
$0458, $0459, $045a, $045b, $045c, $00a7, $045e, $045f
|
||||
);
|
||||
|
||||
{ARABIC
|
||||
}
|
||||
CharISO_8859_6:array [128..255] of word =
|
||||
(
|
||||
$0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087,
|
||||
$0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
|
||||
$0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097,
|
||||
$0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
|
||||
$00a0, $fffd, $fffd, $fffd, $00a4, $fffd, $fffd, $fffd,
|
||||
$fffd, $fffd, $fffd, $fffd, $060c, $00ad, $fffd, $fffd,
|
||||
$fffd, $fffd, $fffd, $fffd, $fffd, $fffd, $fffd, $fffd,
|
||||
$fffd, $fffd, $fffd, $061b, $fffd, $fffd, $fffd, $061f,
|
||||
$fffd, $0621, $0622, $0623, $0624, $0625, $0626, $0627,
|
||||
$0628, $0629, $062a, $062b, $062c, $062d, $062e, $062f,
|
||||
$0630, $0631, $0632, $0633, $0634, $0635, $0636, $0637,
|
||||
$0638, $0639, $063a, $fffd, $fffd, $fffd, $fffd, $fffd,
|
||||
$0640, $0641, $0642, $0643, $0644, $0645, $0646, $0647,
|
||||
$0648, $0649, $064a, $064b, $064c, $064d, $064e, $064f,
|
||||
$0650, $0651, $0652, $fffd, $fffd, $fffd, $fffd, $fffd,
|
||||
$fffd, $fffd, $fffd, $fffd, $fffd, $fffd, $fffd, $fffd
|
||||
);
|
||||
|
||||
{GREEK
|
||||
}
|
||||
CharISO_8859_7:array [128..255] of word =
|
||||
(
|
||||
$0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087,
|
||||
$0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
|
||||
$0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097,
|
||||
$0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
|
||||
$00a0, $2018, $2019, $00a3, $fffd, $fffd, $00a6, $00a7,
|
||||
$00a8, $00a9, $fffd, $00ab, $00ac, $00ad, $fffd, $2015,
|
||||
$00b0, $00b1, $00b2, $00b3, $0384, $0385, $0386, $00b7,
|
||||
$0388, $0389, $038a, $00bb, $038c, $00bd, $038e, $038f,
|
||||
$0390, $0391, $0392, $0393, $0394, $0395, $0396, $0397,
|
||||
$0398, $0399, $039a, $039b, $039c, $039d, $039e, $039f,
|
||||
$03a0, $03a1, $fffd, $03a3, $03a4, $03a5, $03a6, $03a7,
|
||||
$03a8, $03a9, $03aa, $03ab, $03ac, $03ad, $03ae, $03af,
|
||||
$03b0, $03b1, $03b2, $03b3, $03b4, $03b5, $03b6, $03b7,
|
||||
$03b8, $03b9, $03ba, $03bb, $03bc, $03bd, $03be, $03bf,
|
||||
$03c0, $03c1, $03c2, $03c3, $03c4, $03c5, $03c6, $03c7,
|
||||
$03c8, $03c9, $03ca, $03cb, $03cc, $03cd, $03ce, $fffd
|
||||
);
|
||||
|
||||
{HEBREW
|
||||
}
|
||||
CharISO_8859_8:array [128..255] of word =
|
||||
(
|
||||
$0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087,
|
||||
$0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
|
||||
$0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097,
|
||||
$0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
|
||||
$00a0, $fffd, $00a2, $00a3, $00a4, $00a5, $00a6, $00a7,
|
||||
$00a8, $00a9, $00d7, $00ab, $00ac, $00ad, $00ae, $00af,
|
||||
$00b0, $00b1, $00b2, $00b3, $00b4, $00b5, $00b6, $00b7,
|
||||
$00b8, $00b9, $00f7, $00bb, $00bc, $00bd, $00be, $fffd,
|
||||
$fffd, $fffd, $fffd, $fffd, $fffd, $fffd, $fffd, $fffd,
|
||||
$fffd, $fffd, $fffd, $fffd, $fffd, $fffd, $fffd, $fffd,
|
||||
$fffd, $fffd, $fffd, $fffd, $fffd, $fffd, $fffd, $fffd,
|
||||
$fffd, $fffd, $fffd, $fffd, $fffd, $fffd, $fffd, $2017,
|
||||
$05d0, $05d1, $05d2, $05d3, $05d4, $05d5, $05d6, $05d7,
|
||||
$05d8, $05d9, $05da, $05db, $05dc, $05dd, $05de, $05df,
|
||||
$05e0, $05e1, $05e2, $05e3, $05e4, $05e5, $05e6, $05e7,
|
||||
$05e8, $05e9, $05ea, $fffd, $fffd, $200e, $200f, $fffd
|
||||
);
|
||||
|
||||
{Latin-5
|
||||
English, Finnish, French, German, Irish, Italian, Norwegian, Portuguese,
|
||||
Spanish, Swedish and Turkish.
|
||||
}
|
||||
CharISO_8859_9:array [128..255] of word =
|
||||
(
|
||||
$0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087,
|
||||
$0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
|
||||
$0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097,
|
||||
$0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
|
||||
$00a0, $0104, $02d8, $0141, $00a4, $013d, $015a, $00a7,
|
||||
$00a8, $0160, $015e, $0164, $0179, $00ad, $017d, $017b,
|
||||
$00b0, $0105, $02db, $0142, $00b4, $013e, $015b, $02c7,
|
||||
$00b8, $0161, $015f, $0165, $017a, $02dd, $017e, $017c,
|
||||
$0154, $00c1, $00c2, $0102, $00c4, $0139, $0106, $00c7,
|
||||
$010c, $00c9, $0118, $00cb, $011a, $00cd, $00ce, $010e,
|
||||
$011e, $00d1, $00d2, $00d3, $00d4, $00d5, $00d6, $00d7,
|
||||
$00d8, $00d9, $00da, $00db, $00dc, $0130, $015e, $00df,
|
||||
$00e0, $00e1, $00e2, $00e3, $00e4, $00e5, $00e6, $00e7,
|
||||
$00e8, $00e9, $00ea, $00eb, $00ec, $00ed, $00ee, $00ef,
|
||||
$011f, $00f1, $00f2, $00f3, $00f4, $00f5, $00f6, $00f7,
|
||||
$00f8, $00f9, $00fa, $00fb, $00fc, $0131, $015f, $00ff
|
||||
);
|
||||
|
||||
{Latin-6
|
||||
Danish, English, Estonian, Faeroese, Finnish, German, Greenlandic, Icelandic,
|
||||
Lappish, Latvian, Lithuanian, Norwegian and Swedish.
|
||||
}
|
||||
CharISO_8859_10:array [128..255] of word =
|
||||
(
|
||||
$0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087,
|
||||
$0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
|
||||
$0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097,
|
||||
$0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
|
||||
$00a0, $0104, $0112, $0122, $012a, $0128, $0136, $00a7,
|
||||
$013b, $0110, $0160, $0166, $017d, $00ad, $016a, $014a,
|
||||
$00b0, $0105, $0113, $0123, $012b, $0129, $0137, $00b7,
|
||||
$013c, $0111, $0161, $0167, $017e, $2015, $016b, $014b,
|
||||
$0100, $00c1, $00c2, $00c3, $00c4, $00c5, $00c6, $012e,
|
||||
$010c, $00c9, $0118, $00cb, $0116, $00cd, $00ce, $00cf,
|
||||
$00d0, $0145, $014c, $00d3, $00d4, $00d5, $00d6, $0168,
|
||||
$00d8, $0172, $00da, $00db, $00dc, $00dd, $00de, $00df,
|
||||
$0101, $00e1, $00e2, $00e3, $00e4, $00e5, $00e6, $012f,
|
||||
$010d, $00e9, $0119, $00eb, $0117, $00ed, $00ee, $00ef,
|
||||
$00f0, $0146, $014d, $00f3, $00f4, $00f5, $00f6, $0169,
|
||||
$00f8, $0173, $00fa, $00fb, $00fc, $00fd, $00fe, $0138
|
||||
);
|
||||
|
||||
{Eastern European
|
||||
}
|
||||
CharCP_1250:array [128..255] of word =
|
||||
(
|
||||
$20ac, $fffd, $201a, $fffd, $201e, $2026, $2020, $2021,
|
||||
$fffd, $2030, $0160, $2039, $015a, $0164, $017d, $0179,
|
||||
$fffd, $2018, $2019, $201c, $201d, $2022, $2013, $2014,
|
||||
$fffd, $2122, $0161, $203a, $015b, $0165, $017e, $017a,
|
||||
$00a0, $02c7, $02d8, $0141, $00a4, $0104, $00a6, $00a7,
|
||||
$00a8, $00a9, $015e, $00ab, $00ac, $00ad, $00ae, $017b,
|
||||
$00b0, $00b1, $02db, $0142, $00b4, $00b5, $00b6, $00b7,
|
||||
$00b8, $0105, $015f, $00bb, $013d, $02dd, $013e, $017c,
|
||||
$0154, $00c1, $00c2, $0102, $00c4, $0139, $0106, $00c7,
|
||||
$010c, $00c9, $0118, $00cb, $011a, $00cd, $00ce, $010e,
|
||||
$0110, $0143, $0147, $00d3, $00d4, $0150, $00d6, $00d7,
|
||||
$0158, $016e, $00da, $0170, $00dc, $00dd, $0162, $00df,
|
||||
$0155, $00e1, $00e2, $0103, $00e4, $013a, $0107, $00e7,
|
||||
$010d, $00e9, $0119, $00eb, $011b, $00ed, $00ee, $010f,
|
||||
$0111, $0144, $0148, $00f3, $00f4, $0151, $00f6, $00f7,
|
||||
$0159, $016f, $00fa, $0171, $00fc, $00fd, $0163, $02d9
|
||||
);
|
||||
|
||||
{Cyrillic
|
||||
}
|
||||
CharCP_1251:array [128..255] of word =
|
||||
(
|
||||
$0402, $0403, $201a, $0453, $201e, $2026, $2020, $2021,
|
||||
$20ac, $2030, $0409, $2039, $040a, $040c, $040b, $040f,
|
||||
$0452, $2018, $2019, $201c, $201d, $2022, $2013, $2014,
|
||||
$fffd, $2122, $0459, $203a, $045a, $045c, $045b, $045f,
|
||||
$00a0, $040e, $045e, $0408, $00a4, $0490, $00a6, $00a7,
|
||||
$0401, $00a9, $0404, $00ab, $00ac, $00ad, $00ae, $0407,
|
||||
$00b0, $00b1, $0406, $0456, $0491, $00b5, $00b6, $00b7,
|
||||
$0451, $2116, $0454, $00bb, $0458, $0405, $0455, $0457,
|
||||
$0410, $0411, $0412, $0413, $0414, $0415, $0416, $0417,
|
||||
$0418, $0419, $041a, $041b, $041c, $041d, $041e, $041f,
|
||||
$0420, $0421, $0422, $0423, $0424, $0425, $0426, $0427,
|
||||
$0428, $0429, $042a, $042b, $042c, $042d, $042e, $042f,
|
||||
$0430, $0431, $0432, $0433, $0434, $0435, $0436, $0437,
|
||||
$0438, $0439, $043a, $043b, $043c, $043d, $043e, $043f,
|
||||
$0440, $0441, $0442, $0443, $0444, $0445, $0446, $0447,
|
||||
$0448, $0449, $044a, $044b, $044c, $044d, $044e, $044f
|
||||
);
|
||||
|
||||
{Latin-1 (US, Western Europe)
|
||||
}
|
||||
CharCP_1252:array [128..255] of word =
|
||||
(
|
||||
$20ac, $fffd, $201a, $0192, $201e, $2026, $2020, $2021,
|
||||
$02c6, $2030, $0160, $2039, $0152, $fffd, $017d, $fffd,
|
||||
$fffd, $2018, $2019, $201c, $201d, $2022, $2013, $2014,
|
||||
$02dc, $2122, $0161, $203a, $0153, $fffd, $017e, $0178,
|
||||
$00A0, $00A1, $00A2, $00A3, $00A4, $00A5, $00A6, $00A7,
|
||||
$00A8, $00A9, $00AA, $00AB, $00AC, $00AD, $00AE, $00AF,
|
||||
$00B0, $00B1, $00B2, $00B3, $00B4, $00B5, $00B6, $00B7,
|
||||
$00B8, $00B9, $00BA, $00BB, $00BC, $00BD, $00BE, $00BF,
|
||||
$00C0, $00C1, $00C2, $00C3, $00C4, $00C5, $00C6, $00C7,
|
||||
$00C8, $00C9, $00CA, $00CB, $00CC, $00CD, $00CE, $00CF,
|
||||
$00D0, $00D1, $00D2, $00D3, $00D4, $00D5, $00D6, $00D7,
|
||||
$00D8, $00D9, $00DA, $00DB, $00DC, $00DD, $00DE, $00DF,
|
||||
$00E0, $00E1, $00E2, $00E3, $00E4, $00E5, $00E6, $00E7,
|
||||
$00E8, $00E9, $00EA, $00EB, $00EC, $00ED, $00EE, $00EF,
|
||||
$00F0, $00F1, $00F2, $00F3, $00F4, $00F5, $00F6, $00F7,
|
||||
$00F8, $00F9, $00FA, $00FB, $00FC, $00FD, $00FE, $00FF
|
||||
);
|
||||
|
||||
{Greek
|
||||
}
|
||||
CharCP_1253:array [128..255] of word =
|
||||
(
|
||||
$20ac, $fffd, $201a, $0192, $201e, $2026, $2020, $2021,
|
||||
$fffd, $2030, $fffd, $2039, $fffd, $fffd, $fffd, $fffd,
|
||||
$fffd, $2018, $2019, $201c, $201d, $2022, $2013, $2014,
|
||||
$fffd, $2122, $fffd, $203a, $fffd, $fffd, $fffd, $fffd,
|
||||
$00a0, $0385, $0386, $00a3, $00a4, $00a5, $00a6, $00a7,
|
||||
$00a8, $00a9, $fffd, $00ab, $00ac, $00ad, $00ae, $2015,
|
||||
$00b0, $00b1, $00b2, $00b3, $0384, $00b5, $00b6, $00b7,
|
||||
$0388, $0389, $038a, $00bb, $038c, $00bd, $038e, $038f,
|
||||
$0390, $0391, $0392, $0393, $0394, $0395, $0396, $0397,
|
||||
$0398, $0399, $039a, $039b, $039c, $039d, $039e, $039f,
|
||||
$03a0, $03a1, $fffd, $03a3, $03a4, $03a5, $03a6, $03a7,
|
||||
$03a8, $03a9, $03aa, $03ab, $03ac, $03ad, $03ae, $03af,
|
||||
$03b0, $03b1, $03b2, $03b3, $03b4, $03b5, $03b6, $03b7,
|
||||
$03b8, $03b9, $03ba, $03bb, $03bc, $03bd, $03be, $03bf,
|
||||
$03c0, $03c1, $03c2, $03c3, $03c4, $03c5, $03c6, $03c7,
|
||||
$03c8, $03c9, $03ca, $03cb, $03cc, $03cd, $03ce, $fffd
|
||||
);
|
||||
|
||||
{Turkish
|
||||
}
|
||||
CharCP_1254:array [128..255] of word =
|
||||
(
|
||||
$20ac, $fffd, $201a, $0192, $201e, $2026, $2020, $2021,
|
||||
$02c6, $2030, $0160, $2039, $0152, $fffd, $fffd, $fffd,
|
||||
$fffd, $2018, $2019, $201c, $201d, $2022, $2013, $2014,
|
||||
$02dc, $2122, $0161, $203a, $0153, $fffd, $fffd, $0178,
|
||||
$00A0, $00A1, $00A2, $00A3, $00A4, $00A5, $00A6, $00A7,
|
||||
$00A8, $00A9, $00AA, $00AB, $00AC, $00AD, $00AE, $00AF,
|
||||
$00B0, $00B1, $00B2, $00B3, $00B4, $00B5, $00B6, $00B7,
|
||||
$00B8, $00B9, $00BA, $00BB, $00BC, $00BD, $00BE, $00BF,
|
||||
$00C0, $00C1, $00C2, $00C3, $00C4, $00C5, $00C6, $00C7,
|
||||
$00C8, $00C9, $00CA, $00CB, $00CC, $00CD, $00CE, $00CF,
|
||||
$011e, $00d1, $00d2, $00d3, $00d4, $00d5, $00d6, $00d7,
|
||||
$00d8, $00d9, $00da, $00db, $00dc, $0130, $015e, $00df,
|
||||
$00E0, $00E1, $00E2, $00E3, $00E4, $00E5, $00E6, $00E7,
|
||||
$00E8, $00E9, $00EA, $00EB, $00EC, $00ED, $00EE, $00EF,
|
||||
$011f, $00f1, $00f2, $00f3, $00f4, $00f5, $00f6, $00f7,
|
||||
$00f8, $00f9, $00fa, $00fb, $00fc, $0131, $015f, $00ff
|
||||
);
|
||||
|
||||
{Hebrew
|
||||
}
|
||||
CharCP_1255:array [128..255] of word =
|
||||
(
|
||||
$20ac, $fffd, $201a, $0192, $201e, $2026, $2020, $2021,
|
||||
$02c6, $2030, $fffd, $2039, $fffd, $fffd, $fffd, $fffd,
|
||||
$fffd, $2018, $2019, $201c, $201d, $2022, $2013, $2014,
|
||||
$02dc, $2122, $fffd, $203a, $fffd, $fffd, $fffd, $fffd,
|
||||
$00a0, $00a1, $00a2, $00a3, $20aa, $00a5, $00a6, $00a7,
|
||||
$00a8, $00a9, $00d7, $00ab, $00ac, $00ad, $00ae, $00af,
|
||||
$00b0, $00b1, $00b2, $00b3, $00b4, $00b5, $00b6, $00b7,
|
||||
$00b8, $00b9, $00f7, $00bb, $00bc, $00bd, $00be, $00bf,
|
||||
$05b0, $05b1, $05b2, $05b3, $05b4, $05b5, $05b6, $05b7,
|
||||
$05b8, $05b9, $fffd, $05bb, $05bc, $05bd, $05be, $05bf,
|
||||
$05c0, $05c1, $05c2, $05c3, $05f0, $05f1, $05f2, $05f3,
|
||||
$05f4, $fffd, $fffd, $fffd, $fffd, $fffd, $fffd, $fffd,
|
||||
$05d0, $05d1, $05d2, $05d3, $05d4, $05d5, $05d6, $05d7,
|
||||
$05d8, $05d9, $05da, $05db, $05dc, $05dd, $05de, $05df,
|
||||
$05e0, $05e1, $05e2, $05e3, $05e4, $05e5, $05e6, $05e7,
|
||||
$05e8, $05e9, $05ea, $fffd, $fffd, $200e, $200f, $fffd
|
||||
);
|
||||
|
||||
{Arabic
|
||||
}
|
||||
CharCP_1256:array [128..255] of word =
|
||||
(
|
||||
$20ac, $067e, $201a, $0192, $201e, $2026, $2020, $2021,
|
||||
$02c6, $2030, $0679, $2039, $0152, $0686, $0698, $0688,
|
||||
$06af, $2018, $2019, $201c, $201d, $2022, $2013, $2014,
|
||||
$06a9, $2122, $0691, $203a, $0153, $200c, $200d, $06ba,
|
||||
$00a0, $060c, $00a2, $00a3, $00a4, $00a5, $00a6, $00a7,
|
||||
$00a8, $00a9, $06be, $00ab, $00ac, $00ad, $00ae, $00af,
|
||||
$00b0, $00b1, $00b2, $00b3, $00b4, $00b5, $00b6, $00b7,
|
||||
$00b8, $00b9, $061b, $00bb, $00bc, $00bd, $00be, $061f,
|
||||
$06c1, $0621, $0622, $0623, $0624, $0625, $0626, $0627,
|
||||
$0628, $0629, $062a, $062b, $062c, $062d, $062e, $062f,
|
||||
$0630, $0631, $0632, $0633, $0634, $0635, $0636, $00d7,
|
||||
$0637, $0638, $0639, $063a, $0640, $0641, $0642, $0643,
|
||||
$00e0, $0644, $00e2, $0645, $0646, $0647, $0648, $00e7,
|
||||
$00e8, $00e9, $00ea, $00eb, $0649, $064a, $00ee, $00ef,
|
||||
$064b, $064c, $064d, $064e, $00f4, $064f, $0650, $00f7,
|
||||
$0651, $00f9, $0652, $00fb, $00fc, $200e, $200f, $06d2
|
||||
);
|
||||
|
||||
{Baltic
|
||||
}
|
||||
CharCP_1257:array [128..255] of word =
|
||||
(
|
||||
$20ac, $fffd, $201a, $fffd, $201e, $2026, $2020, $2021,
|
||||
$fffd, $2030, $fffd, $2039, $fffd, $00a8, $02c7, $00b8,
|
||||
$fffd, $2018, $2019, $201c, $201d, $2022, $2013, $2014,
|
||||
$fffd, $2122, $fffd, $203a, $fffd, $00af, $02db, $fffd,
|
||||
$00a0, $fffd, $00a2, $00a3, $00a4, $fffd, $00a6, $00a7,
|
||||
$00d8, $00a9, $0156, $00ab, $00ac, $00ad, $00ae, $00c6,
|
||||
$00b0, $00b1, $00b2, $00b3, $00b4, $00b5, $00b6, $00b7,
|
||||
$00f8, $00b9, $0157, $00bb, $00bc, $00bd, $00be, $00e6,
|
||||
$0104, $012e, $0100, $0106, $00c4, $00c5, $0118, $0112,
|
||||
$010c, $00c9, $0179, $0116, $0122, $0136, $012a, $013b,
|
||||
$0160, $0143, $0145, $00d3, $014c, $00d5, $00d6, $00d7,
|
||||
$0172, $0141, $015a, $016a, $00dc, $017b, $017d, $00df,
|
||||
$0105, $012f, $0101, $0107, $00e4, $00e5, $0119, $0113,
|
||||
$010d, $00e9, $017a, $0117, $0123, $0137, $012b, $013c,
|
||||
$0161, $0144, $0146, $00f3, $014d, $00f5, $00f6, $00f7,
|
||||
$0173, $0142, $015b, $016b, $00fc, $017c, $017e, $02d9
|
||||
);
|
||||
|
||||
{??
|
||||
}
|
||||
CharCP_1258:array [128..255] of word =
|
||||
(
|
||||
$20ac, $fffd, $201a, $0192, $201e, $2026, $2020, $2021,
|
||||
$02c6, $2030, $fffd, $2039, $0152, $fffd, $fffd, $fffd,
|
||||
$fffd, $2018, $2019, $201c, $201d, $2022, $2013, $2014,
|
||||
$02dc, $2122, $fffd, $203a, $0153, $fffd, $fffd, $0178,
|
||||
$00a0, $00a1, $00a2, $00a3, $00a4, $00a5, $00a6, $00a7,
|
||||
$00a8, $00a9, $00aa, $00ab, $00ac, $00ad, $00ae, $00af,
|
||||
$00b0, $00b1, $00b2, $00b3, $00b4, $00b5, $00b6, $00b7,
|
||||
$00b8, $00b9, $00ba, $00bb, $00bc, $00bd, $00be, $00bf,
|
||||
$00c0, $00c1, $00c2, $0102, $00c4, $00c5, $00c6, $00c7,
|
||||
$00c8, $00c9, $00ca, $00cb, $0300, $00cd, $00ce, $00cf,
|
||||
$0110, $00d1, $0309, $00d3, $00d4, $01a0, $00d6, $00d7,
|
||||
$00d8, $00d9, $00da, $00db, $00dc, $01af, $0303, $00df,
|
||||
$00e0, $00e1, $00e2, $0103, $00e4, $00e5, $00e6, $00e7,
|
||||
$00e8, $00e9, $00ea, $00eb, $0301, $00ed, $00ee, $00ef,
|
||||
$0111, $00f1, $0323, $00f3, $00f4, $01a1, $00f6, $00f7,
|
||||
$00f8, $00f9, $00fa, $00fb, $00fc, $01b0, $20ab, $00ff
|
||||
);
|
||||
|
||||
{==============================================================================}
|
||||
Function DecodeChar(value:string;CharFrom:TMimeChar;CharTo:TMimeChar):string;
|
||||
Function GetCurCP:TMimeChar;
|
||||
Function GetCPfromID(value:string):TMimeChar;
|
||||
Function GetIDfromCP(value:TMimeChar):string;
|
||||
Function NeedEncode(value:string):boolean;
|
||||
Function IdealCoding(value:string;CharFrom:TMimeChar;CharTo:TSetChar):TMimeChar;
|
||||
|
||||
{==============================================================================}
|
||||
implementation
|
||||
|
||||
uses
|
||||
windows, sysutils;
|
||||
|
||||
{==============================================================================}
|
||||
procedure CopyArray(var SourceTable, 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_1: CopyArray(CharISO_8859_1,Result);
|
||||
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);
|
||||
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);
|
||||
end;
|
||||
end;
|
||||
|
||||
{==============================================================================}
|
||||
{DecodeChar}
|
||||
Function DecodeChar(value:string;CharFrom:TMimeChar;CharTo:TMimeChar):string;
|
||||
var
|
||||
uni:word;
|
||||
n,m:integer;
|
||||
b:byte;
|
||||
SourceTable,TargetTable:array [128..255] of word;
|
||||
begin
|
||||
GetArray(CharFrom,SourceTable);
|
||||
GetArray(CharTo,TargetTable);
|
||||
result:='';
|
||||
for n:=1 to length(value) do
|
||||
begin
|
||||
b:=ord(value[n]);
|
||||
if b>128
|
||||
then
|
||||
begin
|
||||
uni:=SourceTable[b];
|
||||
b:=ord(NotFoundChar);
|
||||
for m:=128 to 255 do
|
||||
if TargetTable[m]=uni
|
||||
then
|
||||
begin
|
||||
b:=m;
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
result:=result+char(b);
|
||||
end;
|
||||
end;
|
||||
|
||||
{==============================================================================}
|
||||
{GetCurChar}
|
||||
Function GetCurCP:TMimeChar;
|
||||
var
|
||||
x:integer;
|
||||
begin
|
||||
x:=getACP;
|
||||
result:=CP1252;
|
||||
if x=1250 then result:=CP1250;
|
||||
if x=1251 then result:=CP1251;
|
||||
if x=1253 then result:=CP1253;
|
||||
if x=1254 then result:=CP1254;
|
||||
if x=1255 then result:=CP1255;
|
||||
if x=1256 then result:=CP1256;
|
||||
if x=1257 then result:=CP1257;
|
||||
if x=1258 then result:=CP1258;
|
||||
end;
|
||||
|
||||
{==============================================================================}
|
||||
{GetCpfromID}
|
||||
Function GetCPfromID(value:string):TMimeChar;
|
||||
begin
|
||||
value:=uppercase(value);
|
||||
Result:=ISO_8859_1;
|
||||
if Pos('ISO-8859-10',value)=1 then
|
||||
begin
|
||||
Result:=ISO_8859_10;
|
||||
exit;
|
||||
end;
|
||||
if Pos('ISO-8859-2',value)=1 then
|
||||
begin
|
||||
Result:=ISO_8859_2;
|
||||
exit;
|
||||
end;
|
||||
if Pos('ISO-8859-3',value)=1 then
|
||||
begin
|
||||
Result:=ISO_8859_3;
|
||||
exit;
|
||||
end;
|
||||
if Pos('ISO-8859-4',value)=1 then
|
||||
begin
|
||||
Result:=ISO_8859_4;
|
||||
exit;
|
||||
end;
|
||||
if Pos('ISO-8859-5',value)=1 then
|
||||
begin
|
||||
Result:=ISO_8859_5;
|
||||
exit;
|
||||
end;
|
||||
if Pos('ISO-8859-6',value)=1 then
|
||||
begin
|
||||
Result:=ISO_8859_6;
|
||||
exit;
|
||||
end;
|
||||
if Pos('ISO-8859-7',value)=1 then
|
||||
begin
|
||||
Result:=ISO_8859_7;
|
||||
exit;
|
||||
end;
|
||||
if Pos('ISO-8859-8',value)=1 then
|
||||
begin
|
||||
Result:=ISO_8859_8;
|
||||
exit;
|
||||
end;
|
||||
if Pos('ISO-8859-9',value)=1 then
|
||||
begin
|
||||
Result:=ISO_8859_9;
|
||||
exit;
|
||||
end;
|
||||
if (Pos('WINDOWS-1250',value)=1) or
|
||||
(Pos('X-CP1250',value)=1) then
|
||||
begin
|
||||
Result:=CP1250;
|
||||
exit;
|
||||
end;
|
||||
if (Pos('WINDOWS-1251',value)=1) or
|
||||
(Pos('X-CP1251',value)=1) then
|
||||
begin
|
||||
Result:=CP1251;
|
||||
exit;
|
||||
end;
|
||||
if (Pos('WINDOWS-1252',value)=1) or
|
||||
(Pos('X-CP1252',value)=1) then
|
||||
begin
|
||||
Result:=CP1252;
|
||||
exit;
|
||||
end;
|
||||
if (Pos('WINDOWS-1253',value)=1) or
|
||||
(Pos('X-CP1253',value)=1) then
|
||||
begin
|
||||
Result:=CP1253;
|
||||
exit;
|
||||
end;
|
||||
if (Pos('WINDOWS-1254',value)=1) or
|
||||
(Pos('X-CP1254',value)=1) then
|
||||
begin
|
||||
Result:=CP1254;
|
||||
exit;
|
||||
end;
|
||||
if (Pos('WINDOWS-1255',value)=1) or
|
||||
(Pos('X-CP1255',value)=1) then
|
||||
begin
|
||||
Result:=CP1255;
|
||||
exit;
|
||||
end;
|
||||
if (Pos('WINDOWS-1256',value)=1) or
|
||||
(Pos('X-CP1256',value)=1) then
|
||||
begin
|
||||
Result:=CP1256;
|
||||
exit;
|
||||
end;
|
||||
if (Pos('WINDOWS-1257',value)=1) or
|
||||
(Pos('X-CP1257',value)=1) then
|
||||
begin
|
||||
Result:=CP1257;
|
||||
exit;
|
||||
end;
|
||||
if (Pos('WINDOWS-1258',value)=1) or
|
||||
(Pos('X-CP1258',value)=1) then
|
||||
begin
|
||||
Result:=CP1258;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
{==============================================================================}
|
||||
Function GetIDfromCP(value:TMimeChar):string;
|
||||
begin
|
||||
case Value of
|
||||
ISO_8859_2 : result:='ISO-8859-2';
|
||||
ISO_8859_3 : result:='ISO-8859-3';
|
||||
ISO_8859_4 : result:='ISO-8859-4';
|
||||
ISO_8859_5 : result:='ISO-8859-5';
|
||||
ISO_8859_6 : result:='ISO-8859-6';
|
||||
ISO_8859_7 : result:='ISO-8859-7';
|
||||
ISO_8859_8 : result:='ISO-8859-8';
|
||||
ISO_8859_9 : result:='ISO-8859-9';
|
||||
ISO_8859_10: result:='ISO-8859-10';
|
||||
CP1250 : result:='WINDOWS-1250';
|
||||
CP1251 : result:='WINDOWS-1251';
|
||||
CP1252 : result:='WINDOWS-1252';
|
||||
CP1253 : result:='WINDOWS-1253';
|
||||
CP1254 : result:='WINDOWS-1254';
|
||||
CP1255 : result:='WINDOWS-1255';
|
||||
CP1256 : result:='WINDOWS-1256';
|
||||
CP1257 : result:='WINDOWS-1257';
|
||||
CP1258 : result:='WINDOWS-1258';
|
||||
else result:='ISO-8859-1';
|
||||
end;
|
||||
end;
|
||||
|
||||
{==============================================================================}
|
||||
Function NeedEncode(value:string):boolean;
|
||||
var
|
||||
n:integer;
|
||||
begin
|
||||
result:=false;
|
||||
for n:=1 to length(value) do
|
||||
if ord(value[n])>127 then
|
||||
begin
|
||||
result:=true;
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
|
||||
{==============================================================================}
|
||||
Function IdealCoding(value:string;CharFrom:TMimeChar;CharTo:TSetChar):TMimeChar;
|
||||
var
|
||||
n,m:integer;
|
||||
min,x:integer;
|
||||
s,t:string;
|
||||
begin
|
||||
result:=ISO_8859_1;
|
||||
s:='';
|
||||
for n:=1 to length(value) do
|
||||
if ord(value[n])>127 then
|
||||
s:=s+value[n];
|
||||
min:=128;
|
||||
for n:=ord(low(TMimeChar)) to ord(high(TMimeChar)) do
|
||||
if TMimechar(n) in CharTo then
|
||||
begin
|
||||
t:=Decodechar(s,CharFrom,TMimechar(n));
|
||||
x:=0;
|
||||
for m:=1 to length(t) do
|
||||
if t[m]=NotFoundChar
|
||||
then inc(x);
|
||||
if x<min then
|
||||
begin
|
||||
min:=x;
|
||||
result:=TMimechar(n);
|
||||
if x=0
|
||||
then break;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{==============================================================================}
|
||||
|
||||
begin
|
||||
exit;
|
||||
asm
|
||||
db 'Synapse character transcoding library by Lukas Gebauer',0
|
||||
end;
|
||||
end.
|
||||
288
mimemess.pas
Normal file
288
mimemess.pas
Normal file
@@ -0,0 +1,288 @@
|
||||
{==============================================================================|
|
||||
| Project : Delphree - Synapse | 001.000.000 |
|
||||
|==============================================================================|
|
||||
| Content: MIME message object |
|
||||
|==============================================================================|
|
||||
| The contents of this file are subject to the Mozilla Public License Ver. 1.0 |
|
||||
| (the "License"); you may not use this file except in compliance with the |
|
||||
| License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ |
|
||||
| |
|
||||
| Software distributed under the License is distributed on an "AS IS" basis, |
|
||||
| WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for |
|
||||
| the specific language governing rights and limitations under the License. |
|
||||
|==============================================================================|
|
||||
| The Original Code is Synapse Delphi Library. |
|
||||
|==============================================================================|
|
||||
| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
|
||||
| Portions created by Lukas Gebauer are Copyright (c)2000. |
|
||||
| All Rights Reserved. |
|
||||
|==============================================================================|
|
||||
| Contributor(s): |
|
||||
|==============================================================================|
|
||||
| History: see HISTORY.HTM from distribution package |
|
||||
| (Found at URL: http://www.ararat.cz/synapse/) |
|
||||
|==============================================================================}
|
||||
|
||||
|
||||
unit MIMEmess;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
classes, Sysutils, MimePart, MimeChar, SynaUtil;
|
||||
|
||||
type
|
||||
|
||||
TMessHeader=record
|
||||
from:string;
|
||||
ToList:tstringlist;
|
||||
subject:string;
|
||||
organization:string;
|
||||
end;
|
||||
|
||||
TMimeMess=class(TObject)
|
||||
private
|
||||
public
|
||||
PartList:TList;
|
||||
Lines:TStringList;
|
||||
header:TMessHeader;
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
procedure Clear;
|
||||
function AddPart:integer;
|
||||
procedure AddPartText(value:tstringList);
|
||||
procedure AddPartBinary(value:string);
|
||||
procedure EncodeMessage;
|
||||
procedure FinalizeHeaders;
|
||||
procedure ParseHeaders;
|
||||
procedure DecodeMessage;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{==============================================================================}
|
||||
{TMimeMess.Create}
|
||||
Constructor TMimeMess.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
PartList:=TList.create;
|
||||
Lines:=TStringList.create;
|
||||
Header.ToList:=TStringList.create;
|
||||
end;
|
||||
|
||||
{TMimeMess.Destroy}
|
||||
Destructor TMimeMess.Destroy;
|
||||
begin
|
||||
Header.ToList.free;
|
||||
Lines.free;
|
||||
PartList.free;
|
||||
inherited destroy;
|
||||
end;
|
||||
|
||||
{==============================================================================}
|
||||
{TMimeMess.Clear}
|
||||
procedure TMimeMess.Clear;
|
||||
var
|
||||
n:integer;
|
||||
begin
|
||||
Lines.clear;
|
||||
for n:=0 to PartList.count-1 do
|
||||
TMimePart(PartList[n]).Free;
|
||||
PartList.Clear;
|
||||
with header do
|
||||
begin
|
||||
from:='';
|
||||
ToList.clear;
|
||||
subject:='';
|
||||
organization:='';
|
||||
end;
|
||||
end;
|
||||
|
||||
{==============================================================================}
|
||||
{TMimeMess.AddPart}
|
||||
function TMimeMess.AddPart:integer;
|
||||
var
|
||||
mp:TMimePart;
|
||||
n:integer;
|
||||
begin
|
||||
mp:=TMimePart.create;
|
||||
result:=PartList.Add(mp);
|
||||
end;
|
||||
|
||||
{==============================================================================}
|
||||
{TMimeMess.AddPartText}
|
||||
procedure TMimeMess.AddPartText(value:tstringList);
|
||||
var
|
||||
x:integer;
|
||||
begin
|
||||
x:=Addpart;
|
||||
with TMimePart(PartList[x]) do
|
||||
begin
|
||||
value.SaveToStream(decodedlines);
|
||||
primary:='text';
|
||||
secondary:='plain';
|
||||
description:='message text';
|
||||
CharsetCode:=IdealCoding(value.text,targetCharset,
|
||||
[ISO_8859_1, ISO_8859_2, ISO_8859_3, ISO_8859_4, ISO_8859_5,
|
||||
ISO_8859_6, ISO_8859_7, ISO_8859_8, ISO_8859_9, ISO_8859_10]);
|
||||
EncodingCode:=ME_QUOTED_PRINTABLE;
|
||||
EncodePart;
|
||||
end;
|
||||
end;
|
||||
|
||||
{==============================================================================}
|
||||
{TMimeMess.AddPartBinary}
|
||||
procedure TMimeMess.AddPartBinary(value:string);
|
||||
var
|
||||
n,x:integer;
|
||||
s:string;
|
||||
begin
|
||||
x:=Addpart;
|
||||
with TMimePart(PartList[x]) do
|
||||
begin
|
||||
DecodedLines.LoadFromFile(Value);
|
||||
MimeTypeFromExt(value);
|
||||
description:='attached file';
|
||||
filename:=extractFilename(value);
|
||||
EncodingCode:=ME_BASE64;
|
||||
EncodePart;
|
||||
end;
|
||||
end;
|
||||
|
||||
{==============================================================================}
|
||||
{TMimeMess.Encodemessage}
|
||||
procedure TMimeMess.Encodemessage;
|
||||
var
|
||||
bound:string;
|
||||
n:integer;
|
||||
m:TMimepart;
|
||||
begin
|
||||
lines.clear;
|
||||
If PartList.Count=1
|
||||
then
|
||||
Lines.assign(TMimePart(PartList[0]).lines)
|
||||
else
|
||||
begin
|
||||
bound:=generateboundary;
|
||||
for n:=0 to PartList.count-1 do
|
||||
begin
|
||||
Lines.add('--'+bound);
|
||||
lines.AddStrings(TMimePart(PartList[n]).lines);
|
||||
end;
|
||||
Lines.add('--'+bound);
|
||||
m:=TMimePart.Create;
|
||||
try
|
||||
Lines.SaveToStream(m.DecodedLines);
|
||||
m.Primary:='Multipart';
|
||||
m.secondary:='mixed';
|
||||
m.description:='Multipart message';
|
||||
m.boundary:=bound;
|
||||
m.EncodePart;
|
||||
Lines.assign(m.lines);
|
||||
finally
|
||||
m.free;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{==============================================================================}
|
||||
{TMimeMess.FinalizeHeaders}
|
||||
procedure TMimeMess.FinalizeHeaders;
|
||||
var
|
||||
s:string;
|
||||
n:integer;
|
||||
begin
|
||||
Lines.Insert(0,'x-mailer: Synapse - Delphi TCP/IP library by Lukas Gebauer');
|
||||
Lines.Insert(0,'MIME-Version: 1.0 (produced by Synapse)');
|
||||
Lines.Insert(0,'date: '+Rfc822DateTime(now));
|
||||
if header.organization<>''
|
||||
then Lines.Insert(0,'Organization: '+InlineCode(header.organization));
|
||||
if header.subject<>''
|
||||
then Lines.Insert(0,'Subject: '+InlineCode(header.subject));
|
||||
for n:=0 to Header.ToList.count-1 do
|
||||
Lines.Insert(0,'To: '+InlineEmail(header.ToList[n]));
|
||||
Lines.Insert(0,'From: '+InlineEmail(header.from));
|
||||
end;
|
||||
|
||||
{==============================================================================}
|
||||
{TMimeMess.ParseHeaders}
|
||||
procedure TMimeMess.ParseHeaders;
|
||||
var
|
||||
s:string;
|
||||
n:integer;
|
||||
cp:TMimeChar;
|
||||
begin
|
||||
cp:=getCurCP;
|
||||
header.ToList.clear;
|
||||
for n:=0 to lines.count-1 do
|
||||
begin
|
||||
s:=lines[n];
|
||||
if s=''
|
||||
then break;
|
||||
If pos('FROM:',uppercase(s))=1
|
||||
then header.from:=InlineDecode(separateright(s,':'),cp);
|
||||
If pos('SUBJECT:',uppercase(s))=1
|
||||
then header.subject:=InlineDecode(separateright(s,':'),cp);
|
||||
If pos('ORGANIZATION:',uppercase(s))=1
|
||||
then header.organization:=InlineDecode(separateright(s,':'),cp);
|
||||
If pos('TO:',uppercase(s))=1
|
||||
then header.ToList.add(InlineDecode(separateright(s,':'),cp));
|
||||
end;
|
||||
end;
|
||||
|
||||
{==============================================================================}
|
||||
{TMimeMess.DecodeMessage}
|
||||
procedure TMimeMess.DecodeMessage;
|
||||
var
|
||||
l:tstringlist;
|
||||
m:tmimepart;
|
||||
x,i,n:integer;
|
||||
bound,s:string;
|
||||
begin
|
||||
l:=tstringlist.create;
|
||||
m:=tmimepart.create;
|
||||
try
|
||||
l.assign(lines);
|
||||
normalizepart(l);
|
||||
with header do
|
||||
begin
|
||||
from:='';
|
||||
ToList.clear;
|
||||
subject:='';
|
||||
organization:='';
|
||||
end;
|
||||
ParseHeaders;
|
||||
m.ExtractPart(l,0);
|
||||
if m.primarycode=MP_MULTIPART
|
||||
then
|
||||
begin
|
||||
bound:=m.boundary;
|
||||
i:=0;
|
||||
repeat
|
||||
x:=AddPart;
|
||||
with TMimePart(PartList[x]) do
|
||||
begin
|
||||
boundary:=bound;
|
||||
i:=ExtractPart(l,i);
|
||||
DecodePart;
|
||||
end;
|
||||
until i>=l.count-2;
|
||||
end
|
||||
else
|
||||
begin
|
||||
x:=AddPart;
|
||||
with TMimePart(PartList[x]) do
|
||||
begin
|
||||
ExtractPart(l,0);
|
||||
DecodePart;
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
m.free;
|
||||
l.free;
|
||||
end;
|
||||
end;
|
||||
|
||||
{==============================================================================}
|
||||
|
||||
end.
|
||||
639
mimepart.pas
Normal file
639
mimepart.pas
Normal file
@@ -0,0 +1,639 @@
|
||||
{==============================================================================|
|
||||
| Project : Delphree - Synapse | 001.000.000 |
|
||||
|==============================================================================|
|
||||
| Content: MIME support procedures and functions |
|
||||
|==============================================================================|
|
||||
| The contents of this file are subject to the Mozilla Public License Ver. 1.0 |
|
||||
| (the "License"); you may not use this file except in compliance with the |
|
||||
| License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ |
|
||||
| |
|
||||
| Software distributed under the License is distributed on an "AS IS" basis, |
|
||||
| WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for |
|
||||
| the specific language governing rights and limitations under the License. |
|
||||
|==============================================================================|
|
||||
| The Original Code is Synapse Delphi Library. |
|
||||
|==============================================================================|
|
||||
| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
|
||||
| Portions created by Lukas Gebauer are Copyright (c)2000. |
|
||||
| All Rights Reserved. |
|
||||
|==============================================================================|
|
||||
| Contributor(s): |
|
||||
|==============================================================================|
|
||||
| History: see HISTORY.HTM from distribution package |
|
||||
| (Found at URL: http://www.ararat.cz/synapse/) |
|
||||
|==============================================================================}
|
||||
|
||||
unit MIMEpart;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
sysutils, classes, windows, MIMEchar, SynaCode, SynaUtil;
|
||||
|
||||
type
|
||||
|
||||
TMimePrimary=(MP_TEXT,
|
||||
MP_MULTIPART,
|
||||
MP_MESSAGE,
|
||||
MP_BINARY);
|
||||
|
||||
TMimeEncoding=(ME_7BIT,
|
||||
ME_8BIT,
|
||||
ME_QUOTED_PRINTABLE,
|
||||
ME_BASE64);
|
||||
|
||||
TMimePart=class
|
||||
private
|
||||
FPrimary:string;
|
||||
FEncoding:string;
|
||||
FCharset:string;
|
||||
procedure Setprimary(Value:string);
|
||||
procedure SetEncoding(Value:string);
|
||||
procedure SetCharset(Value:string);
|
||||
protected
|
||||
public
|
||||
PrimaryCode:TMimePrimary;
|
||||
EncodingCode:TMimeEncoding;
|
||||
CharsetCode:TMimeChar;
|
||||
TargetCharset:TMimeChar;
|
||||
secondary:string;
|
||||
description:string;
|
||||
boundary:string;
|
||||
FileName:string;
|
||||
Lines:TStringList;
|
||||
DecodedLines:TmemoryStream;
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
procedure clear;
|
||||
function ExtractPart(value:TStringList; BeginLine:integer):integer;
|
||||
procedure DecodePart;
|
||||
procedure EncodePart;
|
||||
procedure MimeTypeFromExt(value:string);
|
||||
property
|
||||
Primary:string read FPrimary Write SetPrimary;
|
||||
property
|
||||
encoding:string read FEncoding write SetEncoding;
|
||||
property
|
||||
Charset:string read FCharset write SetCharset;
|
||||
end;
|
||||
|
||||
const
|
||||
MaxMimeType=15;
|
||||
MimeType:array [0..MaxMimeType,0..2] of string=
|
||||
(
|
||||
('DOC','application','MSWord'),
|
||||
('GIF','image','GIF'),
|
||||
('JPEG','image','JPEG'),
|
||||
('JPG','image','JPEG'),
|
||||
('MPEG','video','MPEG'),
|
||||
('MPG','video','MPEG'),
|
||||
('PDF','application','PDF'),
|
||||
('PNG','image','PNG'),
|
||||
('PS','application','Postscript'),
|
||||
('MOV','video','quicktime'),
|
||||
('RTF','application','RTF'),
|
||||
('TIF','image','TIFF'),
|
||||
('TIFF','image','TIFF'),
|
||||
('WAV','audio','basic'),
|
||||
('WPD','application','Wordperfect5.1'),
|
||||
('ZIP','application','ZIP')
|
||||
);
|
||||
|
||||
procedure NormalizePart(value:Tstringlist);
|
||||
function InlineDecode(value:string;CP:TMimeChar):string;
|
||||
function InlineEncode(value:string;CP,MimeP:TMimeChar):string;
|
||||
Function NeedInline(value:string):boolean;
|
||||
function InlineCode(value:string):string;
|
||||
function InlineEmail(value:string):string;
|
||||
function GenerateBoundary:string;
|
||||
|
||||
implementation
|
||||
|
||||
procedure NormalizePart(value:Tstringlist);
|
||||
var
|
||||
t:tstringlist;
|
||||
x:integer;
|
||||
s:string;
|
||||
begin
|
||||
t:=tstringlist.create;
|
||||
try
|
||||
x:=0;
|
||||
while (value.Count-1) > 0 do
|
||||
begin
|
||||
s:=value[0];
|
||||
if s=''
|
||||
then break;
|
||||
if (s[1]=' ') or (s[1]=#9)
|
||||
then
|
||||
begin
|
||||
s:=' '+trim(s);
|
||||
if t.count=0
|
||||
then t.add(s)
|
||||
else t[t.count-1]:=t[t.count-1]+s;
|
||||
end
|
||||
else
|
||||
t.add(s);
|
||||
value.Delete(0);
|
||||
end;
|
||||
t.AddStrings(value);
|
||||
value.assign(t);
|
||||
finally
|
||||
t.free;
|
||||
end;
|
||||
end;
|
||||
|
||||
{==============================================================================}
|
||||
{TMIMEPart.Create}
|
||||
Constructor TMIMEPart.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
Lines:=TStringList.Create;
|
||||
DecodedLines:=TmemoryStream.create;
|
||||
TargetCharset:=GetCurCP;
|
||||
end;
|
||||
|
||||
{TMIMEPart.Destroy}
|
||||
Destructor TMIMEPart.Destroy;
|
||||
begin
|
||||
DecodedLines.free;
|
||||
Lines.free;
|
||||
inherited destroy;
|
||||
end;
|
||||
|
||||
{==============================================================================}
|
||||
{TMIMEPart.Clear}
|
||||
procedure TMIMEPart.Clear;
|
||||
begin
|
||||
FPrimary:='';
|
||||
FEncoding:='';
|
||||
FCharset:='';
|
||||
PrimaryCode:=MP_TEXT;
|
||||
EncodingCode:=ME_7BIT;
|
||||
CharsetCode:=ISO_8859_1;
|
||||
TargetCharset:=GetCurCP;
|
||||
secondary:='';
|
||||
description:='';
|
||||
boundary:='';
|
||||
FileName:='';
|
||||
Lines.clear;
|
||||
DecodedLines.clear;
|
||||
end;
|
||||
|
||||
{==============================================================================}
|
||||
{TMIMEPart.ExtractPart}
|
||||
function TMIMEPart.ExtractPart(value:TStringList; BeginLine:integer):integer;
|
||||
var
|
||||
n,x,y,x1,x2:integer;
|
||||
t:tstringlist;
|
||||
s,su,b:string;
|
||||
st,st2:string;
|
||||
e:boolean;
|
||||
begin
|
||||
t:=tstringlist.create;
|
||||
try
|
||||
{defaults}
|
||||
lines.clear;
|
||||
primary:='text';
|
||||
secondary:='plain';
|
||||
description:='';
|
||||
charset:='US-ASCII';
|
||||
FileName:='';
|
||||
encoding:='7BIT';
|
||||
|
||||
x:=beginline;
|
||||
b:=boundary;
|
||||
if b<>'' then
|
||||
while value.count>x do
|
||||
begin
|
||||
s:=value[x];
|
||||
inc(x);
|
||||
if pos('--'+b,s)>0
|
||||
then break;
|
||||
end;
|
||||
|
||||
{parse header}
|
||||
while value.count>x do
|
||||
begin
|
||||
s:=value[x];
|
||||
inc(x);
|
||||
if s=''
|
||||
then break;
|
||||
su:=uppercase(s);
|
||||
if pos('CONTENT-TYPE:',su)=1 then
|
||||
begin
|
||||
st:=separateright(su,':');
|
||||
st2:=separateleft(st,';');
|
||||
primary:=separateleft(st2,'/');
|
||||
secondary:=separateright(st2,'/');
|
||||
case primarycode of
|
||||
MP_TEXT:
|
||||
begin
|
||||
charset:=uppercase(getparameter(s,'charset='));
|
||||
end;
|
||||
MP_MULTIPART:
|
||||
begin
|
||||
boundary:=getparameter(s,'boundary=');
|
||||
end;
|
||||
MP_MESSAGE:
|
||||
begin
|
||||
end;
|
||||
MP_BINARY:
|
||||
begin
|
||||
filename:=getparameter(s,'filename=');
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
if pos('CONTENT-TRANSFER-ENCODING:',su)=1 then
|
||||
begin
|
||||
encoding:=separateright(su,':');
|
||||
end;
|
||||
if pos('CONTENT-DESCRIPTION:',su)=1 then
|
||||
begin
|
||||
description:=separateright(s,':');
|
||||
end;
|
||||
end;
|
||||
|
||||
x1:=x;
|
||||
x2:=value.count-1;
|
||||
if b<>'' then
|
||||
begin
|
||||
for n:=x to value.count-1 do
|
||||
begin
|
||||
x2:=n;
|
||||
s:=value[n];
|
||||
if pos('--'+b,s)>0
|
||||
then begin
|
||||
dec(x2);
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
if primarycode=MP_MULTIPART then
|
||||
begin
|
||||
for n:=x to value.count-1 do
|
||||
begin
|
||||
s:=value[n];
|
||||
if pos('--'+boundary,s)>0 then
|
||||
begin
|
||||
x1:=n;
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
for n:=value.count-1 downto x do
|
||||
begin
|
||||
s:=value[n];
|
||||
if pos('--'+boundary,s)>0 then
|
||||
begin
|
||||
x2:=n;
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
for n:=x1 to x2 do
|
||||
lines.add(value[n]);
|
||||
result:=x2;
|
||||
if primarycode=MP_MULTIPART then
|
||||
begin
|
||||
e:=false;
|
||||
for n:=x2+1 to value.count-1 do
|
||||
if pos('--'+boundary,value[n])>0 then
|
||||
begin
|
||||
e:=true;
|
||||
break;
|
||||
end;
|
||||
if not e
|
||||
then result:=value.count-1;
|
||||
end;
|
||||
finally
|
||||
t.free;
|
||||
end;
|
||||
end;
|
||||
|
||||
{==============================================================================}
|
||||
{TMIMEPart.DecodePart}
|
||||
procedure TMIMEPart.DecodePart;
|
||||
const
|
||||
CRLF=#$0D+#$0A;
|
||||
var
|
||||
n:integer;
|
||||
s:string;
|
||||
begin
|
||||
decodedLines.Clear;
|
||||
for n:=0 to lines.count-1 do
|
||||
begin
|
||||
s:=lines[n];
|
||||
case EncodingCode of
|
||||
ME_7BIT:
|
||||
begin
|
||||
s:=s+CRLF;
|
||||
end;
|
||||
ME_8BIT:
|
||||
begin
|
||||
s:=decodeChar(s,CharsetCode,TargetCharset);
|
||||
s:=s+CRLF;
|
||||
end;
|
||||
ME_QUOTED_PRINTABLE:
|
||||
begin
|
||||
if s=''
|
||||
then s:=CRLF
|
||||
else
|
||||
if s[length(s)]<>'='
|
||||
then s:=s+CRLF;
|
||||
s:=DecodeQuotedPrintable(s);
|
||||
s:=decodeChar(s,CharsetCode,TargetCharset);
|
||||
end;
|
||||
ME_BASE64:
|
||||
begin
|
||||
if s<>''
|
||||
then s:=DecodeBase64(s);
|
||||
if PrimaryCode=MP_TEXT
|
||||
then s:=decodeChar(s,CharsetCode,TargetCharset);
|
||||
end;
|
||||
end;
|
||||
Decodedlines.Write(pointer(s)^,length(s));
|
||||
end;
|
||||
decodedlines.Seek(0,soFromBeginning);
|
||||
end;
|
||||
|
||||
{==============================================================================}
|
||||
{TMIMEPart.EncodePart}
|
||||
procedure TMIMEPart.EncodePart;
|
||||
var
|
||||
l:TStringList;
|
||||
s,buff:string;
|
||||
n,x:integer;
|
||||
begin
|
||||
l:=tstringlist.create;
|
||||
Lines.clear;
|
||||
decodedlines.Seek(0,soFromBeginning);
|
||||
try
|
||||
case primarycode of
|
||||
MP_MULTIPART,
|
||||
MP_MESSAGE:
|
||||
begin
|
||||
lines.LoadFromStream(DecodedLines);
|
||||
end;
|
||||
MP_TEXT,
|
||||
MP_BINARY:
|
||||
if EncodingCode=ME_BASE64
|
||||
then
|
||||
begin
|
||||
while decodedlines.Position<decodedlines.Size do
|
||||
begin
|
||||
Setlength(Buff,54);
|
||||
s:='';
|
||||
x:=Decodedlines.Read(pointer(Buff)^,54);
|
||||
for n:=1 to x do
|
||||
s:=s+Buff[n];
|
||||
if PrimaryCode=MP_TEXT
|
||||
then s:=decodeChar(s,TargetCharset,CharsetCode);
|
||||
s:=EncodeBase64(s);
|
||||
if x<>54
|
||||
then s:=s+'=';
|
||||
Lines.add(s);
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
l.LoadFromStream(DecodedLines);
|
||||
for n:=0 to l.count-1 do
|
||||
begin
|
||||
s:=l[n];
|
||||
if PrimaryCode=MP_TEXT
|
||||
then s:=decodeChar(s,TargetCharset,CharsetCode);
|
||||
s:=EncodeQuotedPrintable(s);
|
||||
Lines.add(s);
|
||||
end;
|
||||
end;
|
||||
|
||||
end;
|
||||
Lines.add('');
|
||||
lines.insert(0,'');
|
||||
if secondary='' then
|
||||
case PrimaryCode of
|
||||
MP_TEXT: secondary:='plain';
|
||||
MP_MULTIPART: secondary:='mixed';
|
||||
MP_MESSAGE: secondary:='rfc822';
|
||||
MP_BINARY: secondary:='octet-stream';
|
||||
end;
|
||||
if description<>''
|
||||
then lines.insert(0,'Content-Description: '+Description);
|
||||
case EncodingCode of
|
||||
ME_7BIT: s:='7bit';
|
||||
ME_8BIT: s:='8bit';
|
||||
ME_QUOTED_PRINTABLE: s:='Quoted-printable';
|
||||
ME_BASE64: s:='Base64';
|
||||
end;
|
||||
case PrimaryCode of
|
||||
MP_TEXT,
|
||||
MP_BINARY: lines.insert(0,'Content-Transfer-Encoding: '+s);
|
||||
end;
|
||||
case PrimaryCode of
|
||||
MP_TEXT: s:=primary+'/'+secondary+'; charset='+GetIDfromCP(charsetcode);
|
||||
MP_MULTIPART: s:=primary+'/'+secondary+'; boundary="'+boundary+'"';
|
||||
MP_MESSAGE: s:=primary+'/'+secondary+'';
|
||||
MP_BINARY: s:=primary+'/'+secondary+'; name="'+FileName+'"';
|
||||
end;
|
||||
lines.insert(0,'Content-type: '+s);
|
||||
finally
|
||||
l.free;
|
||||
end;
|
||||
end;
|
||||
|
||||
{==============================================================================}
|
||||
{TMIMEPart.MimeTypeFromExt}
|
||||
procedure TMIMEPart.MimeTypeFromExt(value:string);
|
||||
var
|
||||
s:string;
|
||||
n:integer;
|
||||
begin
|
||||
primary:='';
|
||||
secondary:='';
|
||||
s:=uppercase(separateright(value,'.'));
|
||||
if s=''
|
||||
then s:=uppercase(value);
|
||||
for n:=0 to MaxMimeType do
|
||||
if MimeType[n,0]=s then
|
||||
begin
|
||||
primary:=MimeType[n,1];
|
||||
secondary:=MimeType[n,2];
|
||||
break;
|
||||
end;
|
||||
if primary=''
|
||||
then primary:='application';
|
||||
if secondary=''
|
||||
then secondary:='mixed';
|
||||
end;
|
||||
|
||||
{==============================================================================}
|
||||
{TMIMEPart.Setprimary}
|
||||
procedure TMIMEPart.Setprimary(Value:string);
|
||||
var
|
||||
s:string;
|
||||
begin
|
||||
Fprimary:=Value;
|
||||
s:=uppercase(Value);
|
||||
PrimaryCode:=MP_BINARY;
|
||||
if Pos('TEXT',s)=1
|
||||
then PrimaryCode:=MP_TEXT;
|
||||
if Pos('MULTIPART',s)=1
|
||||
then PrimaryCode:=MP_MULTIPART;
|
||||
if Pos('MESSAGE',s)=1
|
||||
then PrimaryCode:=MP_MESSAGE;
|
||||
end;
|
||||
|
||||
{TMIMEPart.SetEncoding}
|
||||
procedure TMIMEPart.SetEncoding(Value:string);
|
||||
var
|
||||
s:string;
|
||||
begin
|
||||
FEncoding:=Value;
|
||||
s:=uppercase(Value);
|
||||
EncodingCode:=ME_7BIT;
|
||||
if Pos('8BIT',s)=1
|
||||
then EncodingCode:=ME_8BIT;
|
||||
if Pos('QUOTED-PRINTABLE',s)=1
|
||||
then EncodingCode:=ME_QUOTED_PRINTABLE;
|
||||
if Pos('BASE64',s)=1
|
||||
then EncodingCode:=ME_BASE64;
|
||||
end;
|
||||
|
||||
{TMIMEPart.SetCharset}
|
||||
procedure TMIMEPart.SetCharset(Value:string);
|
||||
var
|
||||
s:string;
|
||||
begin
|
||||
FCharset:=Value;
|
||||
CharsetCode:=GetCPfromID(value);
|
||||
end;
|
||||
|
||||
{==============================================================================}
|
||||
{InlineDecode}
|
||||
function InlineDecode(value:string;CP:TMimeChar):string;
|
||||
var
|
||||
s,su:string;
|
||||
x,y,z,n:integer;
|
||||
ichar:TMimeChar;
|
||||
c:char;
|
||||
begin
|
||||
result:=value;
|
||||
x:=pos('=?',uppercase(value));
|
||||
y:=pos('?=',value);
|
||||
if y>x then
|
||||
begin
|
||||
s:=copy(value,x,y-x+2);
|
||||
su:=copy(s,3,length(s)-4);
|
||||
ichar:=GetCPfromID(su);
|
||||
z:=pos('?',su);
|
||||
if (length(su)>=(z+2)) and (su[z+2]='?') then
|
||||
begin
|
||||
c:=uppercase(su)[z+1];
|
||||
su:=copy(su,z+3,length(su)-z-2);
|
||||
if c='B' then
|
||||
begin
|
||||
s:=DecodeBase64(su);
|
||||
s:=DecodeChar(s,ichar,CP);
|
||||
end;
|
||||
if c='Q' then
|
||||
begin
|
||||
s:='';
|
||||
for n:=1 to length(su) do
|
||||
if su[n]='_'
|
||||
then s:=s+' '
|
||||
else s:=s+su[n];
|
||||
s:=DecodeQuotedprintable(s);
|
||||
s:=DecodeChar(s,ichar,CP);
|
||||
end;
|
||||
end;
|
||||
result:=copy(value,1,x-1)+s+copy(value,y+2,length(value)-y-1);
|
||||
repeat
|
||||
s:=InlineDecode(result,CP);
|
||||
if s=result
|
||||
then break;
|
||||
result:=s;
|
||||
until false;
|
||||
end;
|
||||
end;
|
||||
|
||||
{==============================================================================}
|
||||
{InlineEncode}
|
||||
function InlineEncode(value:string;CP,MimeP:TMimeChar):string;
|
||||
var
|
||||
s,s1:string;
|
||||
n:integer;
|
||||
begin
|
||||
s:=DecodeChar(value,CP,MimeP);
|
||||
s:=EncodeQuotedPrintable(s);
|
||||
s1:='';
|
||||
for n:=1 to length(s) do
|
||||
if s[n]=' '
|
||||
then s1:=s1+'=20'
|
||||
else s1:=s1+s[n];
|
||||
result:='=?'+GetIdFromCP(MimeP)+'?Q?'+s1+'?=';
|
||||
end;
|
||||
|
||||
{==============================================================================}
|
||||
{NeedInline}
|
||||
Function NeedInline(value:string):boolean;
|
||||
var
|
||||
n:integer;
|
||||
begin
|
||||
result:=false;
|
||||
for n:=1 to length(value) do
|
||||
if value[n] in (SpecialChar+[char(1)..char(31),char(128)..char(255)]) then
|
||||
begin
|
||||
result:=true;
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
|
||||
{==============================================================================}
|
||||
{InlineCode}
|
||||
function InlineCode(value:string):string;
|
||||
var
|
||||
c:TMimeChar;
|
||||
begin
|
||||
if NeedInline(value)
|
||||
then
|
||||
begin
|
||||
c:=IdealCoding(value,GetCurCP,
|
||||
[ISO_8859_1, ISO_8859_2, ISO_8859_3, ISO_8859_4, ISO_8859_5,
|
||||
ISO_8859_6, ISO_8859_7, ISO_8859_8, ISO_8859_9, ISO_8859_10]);
|
||||
result:=InlineEncode(value,GetCurCP,c);
|
||||
end
|
||||
else result:=value;
|
||||
end;
|
||||
|
||||
{==============================================================================}
|
||||
{InlineEmail}
|
||||
function InlineEmail(value:string):string;
|
||||
var
|
||||
sd,se:string;
|
||||
begin
|
||||
sd:=getEmaildesc(value);
|
||||
se:=getEmailAddr(value);
|
||||
if sd=''
|
||||
then result:=se
|
||||
else result:='"'+InlineCode(sd)+'"<'+se+'>';
|
||||
end;
|
||||
|
||||
{==============================================================================}
|
||||
{GenerateBoundary}
|
||||
function GenerateBoundary:string;
|
||||
var
|
||||
s:string;
|
||||
x:integer;
|
||||
begin
|
||||
randomize;
|
||||
x:=random(maxint);
|
||||
result:='----'+Inttohex(x,8)+'_Synapse_message_boundary';
|
||||
end;
|
||||
|
||||
{==============================================================================}
|
||||
|
||||
begin
|
||||
exit;
|
||||
asm
|
||||
db 'Synapse MIME messages encoding and decoding library by Lukas Gebauer',0
|
||||
end;
|
||||
end.
|
||||
@@ -20,7 +20,7 @@
|
||||
| Contributor(s): |
|
||||
|==============================================================================|
|
||||
| History: see HISTORY.HTM from distribution package |
|
||||
| (Found at URL: http://www.mlp.cz/space/gebauerl/synapse/) |
|
||||
| (Found at URL: http://www.ararat.cz/synapse/) |
|
||||
|==============================================================================}
|
||||
|
||||
{
|
||||
|
||||
36
smtpsend.pas
36
smtpsend.pas
@@ -1,5 +1,5 @@
|
||||
{==============================================================================|
|
||||
| Project : Delphree - Synapse | 001.002.000 |
|
||||
| Project : Delphree - Synapse | 001.003.000 |
|
||||
|==============================================================================|
|
||||
| Content: SMTP client |
|
||||
|==============================================================================|
|
||||
@@ -20,7 +20,7 @@
|
||||
| Contributor(s): |
|
||||
|==============================================================================|
|
||||
| History: see HISTORY.HTM from distribution package |
|
||||
| (Found at URL: http://www.mlp.cz/space/gebauerl/synapse/) |
|
||||
| (Found at URL: http://www.ararat.cz/synapse/) |
|
||||
|==============================================================================}
|
||||
|
||||
unit SMTPsend;
|
||||
@@ -53,6 +53,7 @@ type
|
||||
function maildata(Value:Tstrings):Boolean;
|
||||
end;
|
||||
|
||||
function SendtoRaw (mailfrom,mailto,SMTPHost:string;maildata:TStrings):Boolean;
|
||||
function Sendto (mailfrom,mailto,subject,SMTPHost:string;maildata:TStrings):Boolean;
|
||||
|
||||
implementation
|
||||
@@ -175,14 +176,30 @@ end;
|
||||
|
||||
{==============================================================================}
|
||||
|
||||
|
||||
function Sendto (mailfrom,mailto,subject,SMTPHost:string;maildata:TStrings):Boolean;
|
||||
function SendtoRaw (mailfrom,mailto,SMTPHost:string;maildata:TStrings):Boolean;
|
||||
var
|
||||
SMTP:TSMTPSend;
|
||||
t:TStrings;
|
||||
begin
|
||||
Result:=False;
|
||||
SMTP:=TSMTPSend.Create;
|
||||
try
|
||||
SMTP.SMTPHost:=SMTPHost;
|
||||
if not SMTP.login then Exit;
|
||||
if not SMTP.mailfrom(mailfrom) then Exit;
|
||||
if not SMTP.mailto(mailto) then Exit;
|
||||
if not SMTP.maildata(Maildata) then Exit;
|
||||
SMTP.logout;
|
||||
Result:=True;
|
||||
finally
|
||||
SMTP.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function Sendto (mailfrom,mailto,subject,SMTPHost:string;maildata:TStrings):Boolean;
|
||||
var
|
||||
t:TStrings;
|
||||
begin
|
||||
Result:=False;
|
||||
t:=TStringList.Create;
|
||||
try
|
||||
t.assign(Maildata);
|
||||
@@ -192,15 +209,8 @@ begin
|
||||
t.Insert(0,'date: '+Rfc822DateTime(now));
|
||||
t.Insert(0,'to: '+mailto);
|
||||
t.Insert(0,'from: '+mailfrom);
|
||||
SMTP.SMTPHost:=SMTPHost;
|
||||
if not SMTP.login then Exit;
|
||||
if not SMTP.mailfrom(mailfrom) then Exit;
|
||||
if not SMTP.mailto(mailto) then Exit;
|
||||
if not SMTP.maildata(t) then Exit;
|
||||
SMTP.logout;
|
||||
Result:=True;
|
||||
result:=SendToRaw(mailfrom,mailto,SMTPHost,t);
|
||||
finally
|
||||
SMTP.Free;
|
||||
t.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
@@ -21,7 +21,7 @@
|
||||
| Jean-Fabien Connault (jfconnault@mail.dotcom.fr) |
|
||||
|==============================================================================|
|
||||
| History: see HISTORY.HTM from distribution package |
|
||||
| (Found at URL: http://www.mlp.cz/space/gebauerl/synapse/) |
|
||||
| (Found at URL: http://www.ararat.cz/synapse/) |
|
||||
|==============================================================================}
|
||||
|
||||
unit SNMPSend;
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
{==============================================================================|
|
||||
| Project : Delphree - Synapse | 002.000.000 |
|
||||
| Project : Delphree - Synapse | 002.000.001 |
|
||||
|==============================================================================|
|
||||
| Content: SNMP traps |
|
||||
|==============================================================================|
|
||||
@@ -21,7 +21,7 @@
|
||||
| Hernan Sanchez (hernan.sanchez@iname.com) |
|
||||
|==============================================================================|
|
||||
| History: see HISTORY.HTM from distribution package |
|
||||
| (Found at URL: http://www.mlp.cz/space/gebauerl/synapse/) |
|
||||
| (Found at URL: http://www.ararat.cz/synapse/) |
|
||||
|==============================================================================}
|
||||
|
||||
unit SNMPTrap;
|
||||
@@ -212,7 +212,7 @@ begin
|
||||
Version := StrToIntDef(ASNItem(Pos, Buffer,svt), 0);
|
||||
Community := ASNItem(Pos, Buffer,svt);
|
||||
PDUType := StrToIntDef(ASNItem(Pos, Buffer,svt), PDU_TRAP);
|
||||
Enterprise := IdToMIB(ASNItem(Pos, Buffer,svt));
|
||||
Enterprise := ASNItem(Pos, Buffer,svt);
|
||||
TrapHost := ASNItem(Pos, Buffer,svt);
|
||||
GenTrap := StrToIntDef(ASNItem(Pos, Buffer,svt), 0);
|
||||
Spectrap := StrToIntDef(ASNItem(Pos, Buffer,svt), 0);
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
| Contributor(s): |
|
||||
|==============================================================================|
|
||||
| History: see HISTORY.HTM from distribution package |
|
||||
| (Found at URL: http://www.mlp.cz/space/gebauerl/synapse/) |
|
||||
| (Found at URL: http://www.ararat.cz/synapse/) |
|
||||
|==============================================================================}
|
||||
|
||||
|
||||
|
||||
191
synacode.pas
Normal file
191
synacode.pas
Normal file
@@ -0,0 +1,191 @@
|
||||
{==============================================================================|
|
||||
| Project : Delphree - Synapse | 001.000.000 |
|
||||
|==============================================================================|
|
||||
| Content: Coding and decoding support |
|
||||
|==============================================================================|
|
||||
| The contents of this file are subject to the Mozilla Public License Ver. 1.0 |
|
||||
| (the "License"); you may not use this file except in compliance with the |
|
||||
| License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ |
|
||||
| |
|
||||
| Software distributed under the License is distributed on an "AS IS" basis, |
|
||||
| WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for |
|
||||
| the specific language governing rights and limitations under the License. |
|
||||
|==============================================================================|
|
||||
| The Original Code is Synapse Delphi Library. |
|
||||
|==============================================================================|
|
||||
| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
|
||||
| Portions created by Lukas Gebauer are Copyright (c)2000. |
|
||||
| All Rights Reserved. |
|
||||
|==============================================================================|
|
||||
| Contributor(s): |
|
||||
|==============================================================================|
|
||||
| History: see HISTORY.HTM from distribution package |
|
||||
| (Found at URL: http://www.ararat.cz/synapse/) |
|
||||
|==============================================================================}
|
||||
|
||||
unit SynaCode;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
sysutils;
|
||||
|
||||
const
|
||||
SpecialChar:set of char
|
||||
=['=','(',')','[',']','<','>',':',';','.',',','@','/','?','\','"','_'];
|
||||
|
||||
TableBase64=
|
||||
'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=';
|
||||
{ TableUU=
|
||||
'`!"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';
|
||||
TableXX=
|
||||
'+-0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz';
|
||||
}
|
||||
|
||||
function DecodeQuotedPrintable(value:string):string;
|
||||
function EncodeQuotedPrintable(value:string):string;
|
||||
function Decode4to3(value,table:string):string;
|
||||
function DecodeBase64(value:string):string;
|
||||
function EncodeBase64(value:string):string;
|
||||
|
||||
implementation
|
||||
|
||||
{==============================================================================}
|
||||
{DecodeQuotedPrintable}
|
||||
function DecodeQuotedPrintable(value:string):string;
|
||||
var
|
||||
x:integer;
|
||||
c:char;
|
||||
s:string;
|
||||
begin
|
||||
result:='';
|
||||
x:=1;
|
||||
while x<=length(value) do
|
||||
begin
|
||||
c:=value[x];
|
||||
inc(x);
|
||||
if c<>'='
|
||||
then result:=result+c
|
||||
else
|
||||
if (x+1)<length(value)
|
||||
then
|
||||
begin
|
||||
s:=copy(value,x,2);
|
||||
inc(x,2);
|
||||
result:=result+char(strtointdef('$'+s,32));
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{==============================================================================}
|
||||
{EncodeQuotedPrintable}
|
||||
function EncodeQuotedPrintable(value:string):string;
|
||||
var
|
||||
n:integer;
|
||||
s:string;
|
||||
begin
|
||||
result:='';
|
||||
for n:=1 to length(value) do
|
||||
begin
|
||||
s:=value[n];
|
||||
if s[1] in (SpecialChar+[char(1)..char(31),char(128)..char(255)])
|
||||
then s:='='+inttohex(ord(s[1]),2);
|
||||
result:=result+s;
|
||||
end;
|
||||
end;
|
||||
|
||||
{==============================================================================}
|
||||
{Decode4to3}
|
||||
function Decode4to3(value,table:string):string;
|
||||
var
|
||||
x,y,n:integer;
|
||||
d: array[0..3] of byte;
|
||||
begin
|
||||
result:='';
|
||||
x:=1;
|
||||
while x<length(value) do
|
||||
begin
|
||||
for n:=0 to 3 do
|
||||
begin
|
||||
if x>length(value)
|
||||
then d[n]:=64
|
||||
else
|
||||
begin
|
||||
y:=pos(value[x],table);
|
||||
if y<1 then y:=65;
|
||||
d[n]:=y-1;
|
||||
end;
|
||||
inc(x);
|
||||
end;
|
||||
result:=result+char((D[0] and $3F) shl 2 + (D[1] and $30) shr 4);
|
||||
if d[2]<>64 then
|
||||
begin
|
||||
result:=result+char((D[1] and $0F) shl 4 + (D[2] and $3C) shr 2);
|
||||
if d[3]<>64 then
|
||||
result:=result+char((D[2] and $03) shl 6 + (D[3] and $3F));
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{==============================================================================}
|
||||
{DecodeBase64}
|
||||
function DecodeBase64(value:string):string;
|
||||
begin
|
||||
result:=Decode4to3(value,TableBase64);
|
||||
end;
|
||||
|
||||
{==============================================================================}
|
||||
{EncodeBase64}
|
||||
function EncodeBase64(value:string):string;
|
||||
var
|
||||
c:byte;
|
||||
n:integer;
|
||||
Count:integer;
|
||||
DOut:array [0..3] of byte;
|
||||
begin
|
||||
result:='';
|
||||
Count := 1;
|
||||
while count<=length(value) do
|
||||
begin
|
||||
c:=ord(value[count]);
|
||||
inc(count);
|
||||
DOut[0]:=(c and $FC) shr 2;
|
||||
DOut[1]:=(c and $03) shl 4;
|
||||
if count<=length(value)
|
||||
then
|
||||
begin
|
||||
c:=ord(value[count]);
|
||||
inc(count);
|
||||
DOut[1]:=DOut[1]+(c and $F0) shr 4;
|
||||
DOut[2]:=(c and $0F) shl 2;
|
||||
if count<=length(value)
|
||||
then
|
||||
begin
|
||||
c:=ord(value[count]);
|
||||
inc(count);
|
||||
DOut[2]:=DOut[2]+(c and $C0) shr 6;
|
||||
DOut[3]:=(c and $3F);
|
||||
end
|
||||
else
|
||||
begin
|
||||
DOut[3] := $40;
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
DOut[2] := $40;
|
||||
DOut[3] := $40;
|
||||
end;
|
||||
for n:=0 to 3 do
|
||||
result:=result+TableBase64[DOut[n]+1];
|
||||
end;
|
||||
end;
|
||||
|
||||
{==============================================================================}
|
||||
|
||||
begin
|
||||
exit;
|
||||
asm
|
||||
db 'Synapse coding and decoding support library by Lukas Gebauer',0
|
||||
end;
|
||||
end.
|
||||
102
synautil.pas
102
synautil.pas
@@ -1,5 +1,5 @@
|
||||
{==============================================================================|
|
||||
| Project : Delphree - Synapse | 001.002.001 |
|
||||
| Project : Delphree - Synapse | 001.003.000 |
|
||||
|==============================================================================|
|
||||
| Content: support procedures and functions |
|
||||
|==============================================================================|
|
||||
@@ -22,7 +22,7 @@
|
||||
| Hernan Sanchez (hernan.sanchez@iname.com) |
|
||||
|==============================================================================|
|
||||
| History: see HISTORY.HTM from distribution package |
|
||||
| (Found at URL: http://www.mlp.cz/space/gebauerl/synapse/) |
|
||||
| (Found at URL: http://www.ararat.cz/synapse/) |
|
||||
|==============================================================================}
|
||||
|
||||
unit SynaUtil;
|
||||
@@ -43,6 +43,11 @@ Function MibToId(mib:string):string;
|
||||
Function IdToMib(id:string):string;
|
||||
Function IntMibToStr(int:string):string;
|
||||
function IPToID(Host: string): string;
|
||||
function SeparateLeft(value,delimiter:string):string;
|
||||
function SeparateRight(value,delimiter:string):string;
|
||||
function getparameter(value,parameter:string):string;
|
||||
function GetEmailAddr(value:string):string;
|
||||
function GetEmailDesc(value:string):string;
|
||||
|
||||
implementation
|
||||
|
||||
@@ -253,7 +258,6 @@ begin
|
||||
end;
|
||||
|
||||
{==============================================================================}
|
||||
|
||||
{IntMibToStr}
|
||||
Function IntMibToStr(int:string):string;
|
||||
Var
|
||||
@@ -266,7 +270,6 @@ begin
|
||||
end;
|
||||
|
||||
{==============================================================================}
|
||||
|
||||
{IPToID} //Hernan Sanchez
|
||||
function IPToID(Host: string): string;
|
||||
var
|
||||
@@ -287,6 +290,97 @@ begin
|
||||
Result := Result + Chr(i);
|
||||
end;
|
||||
|
||||
{==============================================================================}
|
||||
{SeparateLeft}
|
||||
function SeparateLeft(value,delimiter:string):string;
|
||||
var
|
||||
x:integer;
|
||||
begin
|
||||
x:=pos(delimiter,value);
|
||||
if x<1
|
||||
then result:=trim(value)
|
||||
else result:=trim(copy(value,1,x-1));
|
||||
end;
|
||||
|
||||
{==============================================================================}
|
||||
{SeparateRight}
|
||||
function SeparateRight(value,delimiter:string):string;
|
||||
var
|
||||
x:integer;
|
||||
begin
|
||||
x:=pos(delimiter,value);
|
||||
result:=trim(copy(value,x+1,length(value)-x));
|
||||
end;
|
||||
|
||||
{==============================================================================}
|
||||
{GetParameter}
|
||||
function getparameter(value,parameter:string):string;
|
||||
var
|
||||
x,x1,n:integer;
|
||||
s:string;
|
||||
begin
|
||||
x:=pos(uppercase(parameter),uppercase(value));
|
||||
result:='';
|
||||
if x>0 then
|
||||
begin
|
||||
s:=copy(value,x+length(parameter),length(value)-(x+length(parameter))+1);
|
||||
s:=trim(s);
|
||||
x1:=length(s);
|
||||
if length(s)>1 then
|
||||
begin
|
||||
if s[1]='"'
|
||||
then
|
||||
begin
|
||||
s:=copy(s,2,length(s)-1);
|
||||
x:=pos('"',s);
|
||||
if x>0 then x1:=x-1;
|
||||
end
|
||||
else
|
||||
begin
|
||||
x:=pos(' ',s);
|
||||
if x>0 then x1:=x-1;
|
||||
end;
|
||||
end;
|
||||
result:=copy(s,1,x1);
|
||||
end;
|
||||
end;
|
||||
|
||||
{==============================================================================}
|
||||
{GetEmailAddr}
|
||||
function GetEmailAddr(value:string):string;
|
||||
var
|
||||
s:string;
|
||||
begin
|
||||
s:=separateright(value,'<');
|
||||
s:=separateleft(s,'>');
|
||||
result:=trim(s);
|
||||
end;
|
||||
|
||||
{==============================================================================}
|
||||
{GetEmailDesc}
|
||||
function GetEmailDesc(value:string):string;
|
||||
var
|
||||
s:string;
|
||||
begin
|
||||
value:=trim(value);
|
||||
s:=separateright(value,'"');
|
||||
if s<>value
|
||||
then s:=separateleft(s,'"')
|
||||
else
|
||||
begin
|
||||
s:=separateright(value,'(');
|
||||
if s<>value
|
||||
then s:=separateleft(s,')')
|
||||
else
|
||||
begin
|
||||
s:=separateleft(value,'<');
|
||||
if s=value
|
||||
then s:='';
|
||||
end;
|
||||
end;
|
||||
result:=trim(s);
|
||||
end;
|
||||
|
||||
{==============================================================================}
|
||||
|
||||
end.
|
||||
|
||||
Reference in New Issue
Block a user