Список форумов Шадринский форум -> Программирование -> Delphi, Pascal, C, C# -> Помогите дописать программу в Delphi

Найти сообщения с вашего последнего посещения

Помогите дописать программу в Delphi

Предыдущая тема :: Следующая тема

Автор

Сообщение

ilyalaptev
Начинающий

Зарегистрирован: 23.12.2009
Сообщения: 14

Статус: Offline

Написал программу почтовый клиент, проблема в том что когда письмо отправляется с браузера то текст письма приходит в кодировке CP 1251 т.е. что то вроде этого "рТПЧЕТЛБ РТПЗТБННЩ!!!", а мой почтовик принимает только KOI8-R, помогите исправить этот недочет. Вот код проги:

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, XpMan, Spin, StdCtrls, IdMessage, IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient, IdMessageClient, IdSMTP, IdAntiFreezeBase,
IdAntiFreeze, IdExplicitTLSClientServerBase, IdPOP3, IdSMTPBase;

type
TForm1 = class(TForm)

GroupBox1: TGroupBox;
Label1: TLabel;
Label2: TLabel;
Edit1: TEdit;
Edit2: TEdit;
Label3: TLabel;
Edit3: TEdit;
GroupBox2: TGroupBox;
Label5: TLabel;
ComboBox1: TComboBox;
Label6: TLabel;
SpinEdit1: TSpinEdit;
Label7: TLabel;
Label8: TLabel;
Edit5: TEdit;
Edit6: TEdit;
Button2: TButton;
OpenDialog1: TOpenDialog;
IdSMTP1: TIdSMTP;
IdMessage1: TIdMessage;
Memo1: TMemo;
IdAntiFreeze1: TIdAntiFreeze;
Button3: TButton;
Memo2: TMemo;
Button4: TButton;
POP3: TIdPOP3;

procedure Button4Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
public
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button2Click(Sender: TObject);
begin
IdSMTP1.Host:=ComboBox1.Text; //Хост (указываем почтовый сервер(smtp.yandex.ru или любой другой т.е где мыло порегали))
IdSMTP1.Port:=SpinEdit1.Value;//Порт SMTP(25) если POP3 то 110
IdSMTP1.Username:=Edit5.Text; //Логин
IdSMTP1.Password:=Edit6.Text; //Пасс
IdMessage1.Body.Text:=Memo1.Text;//Текст письма
IdMessage1.From.Text:=Edit1.Text;//От кого
IdMessage1.Recipients.EMailAddresses:=Edit2.Text;//Кому письмо
IdMessage1.Subject:=Edit3.Text;//Тема письма
IdSmtp1.Connect();//Rонектимся
if IdSMTP1.Connected then //Если конект есть то
IdSMTP1.Send(IdMessage1);//Шлём письмо
idSMTP1.Disconnect;//Дисконект
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
close;
end;

procedure TForm1.Button4Click(Sender: TObject);
label f;
var
mailcicl:integer; // счётчик получаемых писем
addr:string; // папка в которой будут сохраняться получаемые пиьсма
begin
POP3.Host:='pop.yandex.ru'; // адресс почтового сервера
POP3.Port:=110; // порт по которому будет осуществляться подключение
POP3.Username:='lia171@yandex.ru'; // Логин пользователя
POP3.Password:='220400'; // пароль пользователя
addr:=ExtractFilePath(Application.ExeName); // получения адреса папки, в которой находиться наша программа
POP3.Connect; // подключение к серверу
for mailcicl:=1 to 10 do // цикл получения писем
begin
if POP3.CheckMessages<1 then goto f ; // Если писем нет, то выйти и цикла
idMessage1.Clear; // очистка буфера для сообщения
Memo2.Clear; // очистка компонента memo для отображения текста письма.
POP3.Retrieve(1,IdMessage1); // получение одного сообщения
Memo2.Lines.AddStrings(IdMessage1.Body); // передача сообщения из компонента IdMessage в memo
Memo2.Lines.SaveToFile(addr+inttostr(mailcicl)+'.txt'); // сохранение письма в папке, где находится наша программа
POP3.Delete(mailcicl); // удаление письма на сервере
end;
f: // метка выхода из цикла
POP3.Disconnect; // разрыв соединения с сервером
end;

end.

Добавлено спустя 15 минут 3 секунды:

Нашел код для перекодировки текста, помогите его интегрировать в программу...

procedure WinToDos;
var
Src, Str: PChar;
begin
Src := Memo1.Lines.GetText; //Берем текст из TMemo как тип PChar
CharToOem(Src, Str); //API функция для перевода текста
Memo2.Lines.Text := StrPas(Str);//Записываем назад
end;

procedure DosToWin;
var
Src, Str: PChar;
begin
Src := Memo1.Lines.GetText; //Берем текст из TMemo как тип PChar
OemToChar(Src, Str); //API функция для перевода текста
Memo2.Lines.Text := StrPas(Str);//Записываем назад
end;

var
koi8toalt : array [0..127] of char = (
CHR($c4), Chr($b3), Chr($da), Chr($bf),
Chr($c0), Chr($d9), Chr($c3), Chr($b4),
Chr($c2), Chr($c1), Chr($c5), Chr($df),
Chr($dc), Chr($db), Chr($dd), Chr($de),
Chr($b0), Chr($b1), Chr($b2), Chr($f4),
Chr($fe), Chr($f9), Chr($fb), Chr($f7),
Chr($f3), Chr($f2), Chr($ff), Chr($f5),
Chr($f Cool

, Chr($fd), Chr($fa), Chr($f6),
Chr($cd), Chr($ba), Chr($d5), Chr($f1),
Chr($d6), Chr($c9), Chr($b Cool

, Chr($b7),
Chr($bb), Chr($d4), Chr($d3), Chr($c Cool

,
Chr($be), Chr($bd), Chr($bc), Chr($c6),
Chr($c7), Chr($cc), Chr($b5), Chr($f0),
Chr($b6), Chr($b9), Chr($d1), Chr($d2),
Chr($cb), Chr($cf), Chr($d0), Chr($ca),
Chr($d Cool

, Chr($d7), Chr($ce), Chr($fc),
Chr($ee), Chr($a0), Chr($a1), Chr($e6),
Chr($a4), Chr($a5), Chr($e4), Chr($a3),
Chr($e5), Chr($a Cool

, Chr($a9), Chr($aa),
Chr($ab), Chr($ac), Chr($ad), Chr($ae),
Chr($af), Chr($ef), Chr($e0), Chr($e1),
Chr($e2), Chr($e3), Chr($a6), Chr($a2),
Chr($ec), Chr($eb), Chr($a7), Chr($e Cool

,
Chr($ed), Chr($e9), Chr($e7), Chr($ea),
Chr($9e), Chr($80), Chr($81), Chr($96),
Chr($84), Chr($85), Chr($94), Chr($83),
Chr($95), Chr($8 Cool

, Chr($89), Chr($8a),
Chr($8b), Chr($8c), Chr($8d), Chr($8e),
Chr($8f), Chr($9f), Chr($90), Chr($91),
Chr($92), Chr($93), Chr($86), Chr($82),
Chr($9c), Chr($9b), Chr($87), Chr($9 Cool

,
Chr($9d), Chr($99), Chr($97), Chr($9a));

function Koi8toWin(const Data: PChar; DataLen: Integer): PChar;
var
PCh: PChar;
i: Integer;
begin
PCh := Data;
for i := 1 to DataLen do
begin
if Ord(Pch^) > 127 then
Pch^ := koi8toalt[Ord(Pch^) - 128];
Inc(PCh);
end;
PCh := Data;
OemToCharBuff(PCh, PCh, DWORD(DataLen));
Result := Data;
end;

Вернуться к началу

Упуату
Заслуженный писатель

Пол:

Зарегистрирован: 23.05.2006
Сообщения: 3421

Статус: Offline

смотреть компонент/класс TIdMessage на предмет правильности создания текстовых параметров письма. т.е. посмотреть в каком виде оно на сервере находитсяю если там что-то типа
Subject: текст в кодировке 1251
то можно смело перекодировать как угодно. а если всё так хочется сделать как надо, то кодировать по стандартам:
Subject: ?кодировка?b?закодированый текст в base64?=

т.е. для windows-1251 будет выглядеть что то типа вместо

IdMessage1.Subject:=Edit3.Text;//Тема письма

будет что-то типа

IdMessage1.Subject := "?windows-1251?b?" + base64_encode(Edit3.Text) + "?="; //Тема письма

соответственно если надо в кои-8р (хотя зачем?), то еще и перекодировать

IdMessage1.Subject := "?windows-1251?b?" + base64_encode(win2koi(Edit3.Text)) + "?="; //Тема письма

зыЖ функции base64 и win2koi напиши самостоятельно

Вернуться к началу

ilyalaptev
Начинающий

Зарегистрирован: 23.12.2009
Сообщения: 14

Статус: Offline

подскажите поконкретнее как описать функцию base64, заранее благодарен...

Вернуться к началу

Упуату
Заслуженный писатель

Пол:

Зарегистрирован: 23.05.2006
Сообщения: 3421

Статус: Offline

может стоит самому в гугле спросить?

http://ru.wikipedia.org/wiki/Base64 например

а если у гугля спросить "base64 pascal" то он сразу даст нужную функцию

а вообще скорее всего у того компонента она должна быть, ибо стандартный метод кодирования для почты

Вернуться к началу

ilyalaptev
Начинающий

Зарегистрирован: 23.12.2009
Сообщения: 14

Статус: Offline

вы имеете ввиду компонент IdMessage1?

Вернуться к началу

Упуату
Заслуженный писатель

Пол:

Зарегистрирован: 23.05.2006
Сообщения: 3421

Статус: Offline

TIdMessage

IdMessage1 - это экземпляр, насколько я понимаю в паскале )

Вернуться к началу

ilyalaptev
Начинающий

Зарегистрирован: 23.12.2009
Сообщения: 14

Статус: Offline

объясните не опытному пользователю как же все таки описать функцию base64

Вернуться к началу

Dio
Шаман-заводчанин

Пол:

Зарегистрирован: 25.11.2004
Сообщения: 29757

Статус: Offline

http://www.ishodniki.ru/list/info.php?id=3918
Третья ссылка в Яндеске по запросу "Pascal base64 "
_________________
Йа - водоросль.

Вернуться к началу

ilyalaptev
Начинающий

Зарегистрирован: 23.12.2009
Сообщения: 14

Статус: Offline

чтобы получить доступ к исходнику нужно SMS отправить, не вариант...

Добавлено спустя 5 минут 10 секунд:

Что то вроде этого?

function EncodeChunk(const Chunk: String): String;
var
W: LongWord;
i, n: Byte;
begin
n := Length(Chunk); W := 0;

for i := 0 to n - 1 do
W := W + Ord(Chunk[i + 1]) shl ((2 - i) * Cool

;
Result := b64alphabet[(W shr 1 Cool

and $3f] +
b64alphabet[(W shr 12) and $3f] +
b64alphabet[(W shr 06) and $3f] +
b64alphabet[(W shr 00) and $3f];
if n <> 3 then
Result := Copy(Result, 0, n + 1) + Copy(pad, 0, 3 - n); //add padding when out len isn't 24 bits
end;

begin
Result := '';
while Length(Value) > 0 do
begin
Result := Result + EncodeChunk(Copy(Value, 0, 3));
Delete(Value, 1, 3);
end;
end;

Вернуться к началу

Упуату
Заслуженный писатель

Пол:

Зарегистрирован: 23.05.2006
Сообщения: 3421

Статус: Offline

для работы с файлами, переделать думаю не трудно, если трудно, то... дело плохо

Procedure CodeBase64(InFile,OutFile:String);
var  w:word;
     c:char;
     l,k:byte;
     F1,F2:Text;
     Base64Str:String;
begin
 Base64Str:='ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
 assign(F1,InFile);  reset(F1);
 assign(F2,OutFile); rewrite(F2);
 w:=0; l:=0; k:=0;
 while not eof(F1) do
  begin
   read(F1,c); w:=w or ((w or ord(c)) shl (8-l)); inc(l,8);
   while l>= 6 do
    begin
     write(F2,Base64Str[hi(w shr 2)+1]);
     inc(k);
     if k = 60 then begin writeln(F2,'');  k:=0; end;
     w:=w shl 6;
     dec(l,6);
    end;
  end;
 if l > 0 then write(F2,Base64Str[hi(w shr(8-l))+1]);
 Close(F1); Close(F2);
end;

Вернуться к началу

Страница 1 из 1

Найти сообщения с вашего последнего посещения

Список форумов Шадринский форум -> Программирование -> Delphi, Pascal, C, C# -> Помогите дописать программу в Delphi

Перейти:

Вы не можете начинать темы
Вы не можете отвечать на сообщения
Вы не можете редактировать свои сообщения
Вы не можете удалять свои сообщения
Вы не можете голосовать в опросах
Вы не можете вкладывать файлы
Вы можете скачивать файлы

Авторизация

Помогите дописать программу в Delphi