Оригинальный DVD-ROM: eXeL@B DVD !
eXeL@B ВИДЕОКУРС !

Курс видеоуроков КРЭКЕРСТВО + ПРОГРАММИРОВАНИЕ 2017
(актуальность: апрель 2017)
Свежие инструменты, новые видеоуроки!

  • 400+ видеоуроков
  • 800 инструментов
  • 100+ свежих книг и статей

УЗНАТЬ БОЛЬШЕ >>
Домой | Статьи | RAR-cтатьи | FAQ | Форум | Скачать | Видеокурс
Новичку | Ссылки | Программирование | Интервью | Архив | Связь

БОЛЬШОЙ FAQ ПО DELPHI



Как можно перекодировать сообщение (содержание) из Win в КОИ8-Р для отправки по EMail


Разговаривают две фидошницы:
- Знаешь, мы с одним парнем сексом по переписке занимаемся!
- ?! Ну, и как? Оргазм когда-нибудь получаешь?
- Ага... Когда не получаю его дурацких писем.


 const
 
 Koi: array[0..66] of Char = (
 'T', 'Ё', 'ё', 'А', 'Б', 'В', 'Г', 'Д', 'Е', 'Ж',
 'З', 'И', 'Й', 'К', 'Л', 'М', 'Н', 'О', 'П', 'Р',
 'С', 'Т', 'У', 'Ф', 'Х', 'Ц', 'Ч', 'Ш', 'Щ', 'Ъ',
 'Ы', 'Ь', 'Э', 'Ю', 'Я', 'а', 'б', 'в', 'г', 'д',
 'е', 'ж', 'з', 'и', 'й', 'к', 'л', 'м', 'н', 'о',
 'п', 'р', 'с', 'т', 'у', 'ф', 'х', 'ц', 'ч', 'ш',
 'щ', 'ъ', 'ы', 'ь', 'э', 'ю', 'я');
 
 Win: array[0..66] of Char = (
 'ё', 'Ё', 'T', 'ю', 'а', 'б', 'ц', 'д', 'е', 'ф',
 'г', 'х', 'и', 'й', 'к', 'л', 'м', 'н', 'о', 'п',
 'я', 'р', 'с', 'т', 'у', 'ж', 'в', 'ь', 'ы', 'з',
 'ш', 'э', 'щ', 'ч', 'ъ', 'Ю', 'А', 'Б', 'Ц', 'Д',
 'Е', 'Ф', 'Г', 'Х', 'И', 'Й', 'К', 'Л', 'М', 'Н',
 'О', 'П', 'Я', 'Р', 'С', 'Т', 'У', 'Ж', 'В', 'Ь',
 'Ы', 'З', 'Ш', 'Э', 'Щ', 'Ч', 'Ъ');
 
 
 function WinToKoi(Str: string): string;
 var
   i, j, index: Integer;
 begin
   Result := '';
 
   for i := 1 to Length(Str) do
   begin
     index := -1;
     for j := Low(Win) to High(Win) do
       if Win[j] = Str[i] then
       begin
         index := j;
         Break;
       end;
 
     if index = -1 then
       Result := Result + Str[i]
     else
       Result := Result + Koi[index];
   end;
 end;
 
 function KoiToWin(Str: string): string;
 var
   i, j, index: Integer;
 begin
   Result := '';
 
   for i := 1 to Length(Str) do
   begin
     index := -1;
     for j := Low(Win) to High(Win) do
       if Koi[j] = Str[i] then
       begin
         index := j;
         Break;
       end;
 
     if index = -1 then
       Result := Result + Str[i]
     else
       Result := Result + Win[index];
   end;
 end;
 
 
 procedure SendFileOnSMTP(Host: string; Port: Integer;
 Subject, FromAddress, ToAddress, Body, FileName: string);
 var
   NMSMTP: TNMSMTP;
 begin
   if DelSpace(ToAddress) = '' then
     Exit;
   if ToAddress[1] = '' then
     Exit;
 
   if (DelSpace(FileName) <> '') and not FileExists(FileName) then
     raise Exception.Create('SendFileOnSMTP: file not exist: ' + FileName);
 
   NMSMTP := TNMSMTP.Create(nil);
   try
     NMSMTP.Host := Host;
     NMSMTP.Port := Port;
     NMSMTP.Charset := 'koi8-r'
     NMSMTP.PostMessage.FromAddress := FromAddress;
     NMSMTP.PostMessage.ToAddress.Text := ToAddress;
     NMSMTP.PostMessage.Attachments.Text := FileName;
     NMSMTP.PostMessage.Subject := Subject;
     NMSMTP.PostMessage.Date := DateTimeToStr(Now);
     NMSMTP.UserID := 'netmaster'
     NMSMTP.PostMessage.Body.Text := WinToKoi(Body);
     NMSMTP.FinalHeader.Clear;
     NMSMTP.TimeOut := 5000;
     NMSMTP.Connect;
     NMSMTP.SendMail;
     NMSMTP.Disconnect;
   finally
     NMSMTP.Free;
   end;
 end;
 




<< ВЕРНУТЬСЯ В ОГЛАВЛЕНИЕ



Материалы находятся на сайте https://exelab.ru/pro/



Оригинальный DVD-ROM: eXeL@B DVD !


Вы находитесь на EXELAB.rU
Проект ReactOS