Экспертная система Delphi.int.ru

Сообщество программистов
Общение, помощь, обмен опытом
Логин:
Пароль:
Регистрация | Забыли пароль?

Delphi.int.ru Expert

Другие разделы портала

Переход к вопросу:

#   

Статистика за сегодня:  


Лучшие эксперты

Подробнее »

Вопрос # 2 898

Раздел: Delphi » Работа с сетями и протоколами
/ вопрос открыт /

Здравствуйте, уважаемые эксперты!

Вопрос по компонентам Indy10 для Delphi: TIdTCPClient и TIdTCPServer.
Написал по книге простого клиента и сервер с помощью TIdTCPClient и TIdTCPServer. Все хорошо, за исключением того, что русский текст не правильно отображается на сервере. Я так понял, что возможно необходимо манипулировать с кодировкой. Подскажите, а лучше напишите пример, как правильно считать русский текст из TEdit на клиенте, в каком виде отправить его в сеть, как принять (преобразовать) на сервере перед отображенеим в TMemo.
Использую Delphi2009
Нашел еще пример с функциями:
function ToOEM(S: string): string;
begin
Result := '';
if S = '' then Exit;
SetLength(Result, Length(S));
CharToOem(PWideChar(S), PANSIChar(Result));
end;

function FromOEM(S: string): string;
begin
Result := '';
if S = '' then Exit;
SetLength(Result, Length(S));
OEMToChar(PANSIChar(S), PWideChar(Result));
end;

но их применение также не помогло.

Приложение:
  1. unit Main;
  2.  
  3. interface
  4.  
  5. uses
  6. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  7. Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  8. IdEcho, ComCtrls, IdCoder, IdCoder3to4, IdCoderMIME;
  9.  
  10. type
  11. TMainForm = class(TForm)
  12. StatusBar1: TStatusBar;
  13. Memo1: TMemo;
  14. Edit1: TEdit;
  15. IdEcho1: TIdEcho;
  16. Label1: TLabel;
  17. Edit2: TEdit;
  18. Label2: TLabel;
  19. Button1: TButton;
  20. IdDecoderMIME1: TIdDecoderMIME;
  21. IdEncoderMIME1: TIdEncoderMIME;
  22. procedure Button1Click(Sender: TObject);
  23. private
  24. { Private declarations }
  25. public
  26. { Public declarations }
  27. end;
  28.  
  29. var
  30. MainForm: TMainForm;
  31.  
  32. function ToOEM(S: string): string;
  33. function FromOEM(S: string): string;
  34. function FixString(const AData: String): String;
  35.  
  36. implementation
  37.  
  38. {$R *.dfm}
  39.  
  40. function ToOEM(S: string): string;
  41. begin
  42. Result := '';
  43. if S = '' then Exit;
  44. SetLength(Result, Length(S));
  45. CharToOem(PWideChar(S), PANSIChar(Result));
  46. end;
  47.  
  48. function FromOEM(S: string): string;
  49. begin
  50. Result := '';
  51. if S = '' then Exit;
  52. SetLength(Result, Length(S));
  53. OEMToChar(PANSIChar(S), PWideChar(Result));
  54. end;
  55.  
  56. function FixString(const AData: String): String;
  57. type
  58. TW1252 = type AnsiString(1252);
  59. var
  60. W1252: TW1252;
  61. S: RawByteString;
  62. begin
  63.  
  64.  
  65. SetLength(S, Length(W1252));
  66. Move(Pointer(W1252)^, Pointer(S)^, Length(W1252));
  67.  
  68. SetCodePage(S, 1251, False);
  69.  
  70. Result := S;
  71. end;
  72.  
  73.  
  74. procedure TMainForm.Button1Click(Sender: TObject);
  75. begin
  76. try
  77. IdEcho1.Host := Edit1.Text;
  78. IdEcho1.Connect;
  79. try
  80. Memo1.Text := IdEcho1.Echo(Edit2.Text);
  81. finally
  82. IdEcho1.Disconnect;
  83. end;
  84. except
  85.  
  86. end;
  87. end;
  88.  
  89. end.


Roman Novikov Вопрос ожидает решения (принимаются ответы, доступен мини-форум)

Вопрос задал: Roman Novikov (статус: Посетитель)
Вопрос отправлен: 11 июня 2009, 01:36
Состояние вопроса: открыт, ответов: 0.


Мини-форум вопроса

Всего сообщений: 7; последнее сообщение — 12 июня 2009, 19:06; участников в обсуждении: 2.
Вадим К

Вадим К (статус: Академик), 11 июня 2009, 02:17 [#1]:

Если клиент и сервер написаны на 2009 делфи и в коде Вы не делали никаких преобразований строки, то текст ОБЯЗАН отображаться правильно.
Может быть только один случай - когда на сервере просто физически нет нужного шрифта.
Код, который Вы показали, похож на код сервера, но это код плохого сервера. (сервер сам принимает данные от клиентов, а не ждет, пока нажмут кнопку). К тому же, в приведённом коде нет ни слова о TIdTCPClient и TIdTCPServer. Это точно тот пример, о котором Вы говорите?
Галочка "подтверждения прочтения" - вселенское зло.
Roman Novikov

Roman Novikov (статус: Посетитель), 11 июня 2009, 12:53 [#2]:

Код простого сервера. Он принимает сообщения от клиентов и выводит в TMemo.

unit MyServer;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IdBaseComponent, IdComponent, IdCustomTCPServer, IdTCPServer,
StdCtrls, IdContext;

type
TForm1 = class(TForm)
IdTCPServer1: TIdTCPServer;
Memo1: TMemo;
Button1: TButton;
Label1: TLabel;
procedure IdTCPServer1Execute(AContext: TIdContext);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
IdTCPServer1.Active := not IdTCPServer1.Active;
if IdTCPServer1.Active
then Label1.Caption := 'Connected'
else Label1.Caption := 'DisConnected';
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
IdTCPServer1.Active := False;
Action := caFree;
end;

procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
var l: string;
begin
l := AContext.Connection.IOHandler.ReadLn();
Memo1.Lines.Add(l);
end;

end.




Код простого клиента. Он подключается к клиенту при запуске и отправляет сообщение после нажетия кнопки.

unit MyClient;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
IdMessage;

type
TForm1 = class(TForm)
Edit1: TEdit;
IdTCPClient1: TIdTCPClient;
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
//IdTCPClient1.Connect;
IdTCPClient1.IOHandler.WriteLn(Edit1.Text);
//IdTCPClient1.Disconnect;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
IdTCPClient1.Disconnect;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
IdTCPClient1.Connect;
end;

end.



Запускаю клиента и затем несколько клиентов на одном своем компьютере. Отправляю с клиентов сообшение "Hello world!", все приходит без проблем. Если же я пишу на клиенте русский текст "Здравствуйте, товарищи!", то на сервер в TMemo приходит "????????????, ????????!". Говорят что в в исходниках Indy есть ошибка при работе с юникодом. У меня Delphi2009, Indy 10.2.5. Как сделать чтобы приходил русский текст?
Вадим К

Вадим К (статус: Академик), 11 июня 2009, 13:04 [#3]:

Странно, должно работать. надо будет дома посмотреть, что они там умудрились "поломать в коде". Это же надо специально сломать.
А пока - можно просто использовать передачу строки через буфер, а не напрямую.
Галочка "подтверждения прочтения" - вселенское зло.
Roman Novikov

Roman Novikov (статус: Посетитель), 11 июня 2009, 13:21 [#4]:

Я уже несколько дней копаюсь в инете, такая проблема не только у меня. Еще может подскажете сниффер, чтобы проверить по трафику что в сеть уходит/приходит?
Вадим К

Вадим К (статус: Академик), 11 июня 2009, 13:35 [#5]:

я пользуюсь Wireshark (он же Ethereal в молодости) (http://www.wireshark.org)
Галочка "подтверждения прочтения" - вселенское зло.
Roman Novikov

Roman Novikov (статус: Посетитель), 12 июня 2009, 16:00 [#6]:

Как у вас дела? Что-нибудь прояснилось?
Roman Novikov

Roman Novikov (статус: Посетитель), 12 июня 2009, 19:06 [#7]:

Я нашёл ответ на свой вопрос. В методах Readln(TIdEncoding) и Writeln(string, TIdEncoding) необходимо в качестве параметра TIdEncoding прописывать констатну enUTF8 (TIdEncoding = (enDefault, enANSI, enUTF8);).
При этом в разделе Uses подключить IdGlobal.
Итак, рабочий клиент и сервер выглядят следующим образом:


//*******************//
//*Клиентский модуль*//
//*******************//

unit MyClient;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
IdMessage, ComCtrls, ToolWin, ActnMan, ActnCtrls, ActnMenus, ExtCtrls,
PlatformDefaultStyleActnCtrls, ActnList, IdException, IdGlobal;

type
TForm1 = class(TForm)
IdTCPClient1: TIdTCPClient;
Button1: TButton;
StatusBar1: TStatusBar;
ActionMainMenuBar1: TActionMainMenuBar;
RichEdit1: TRichEdit;
ActionManager1: TActionManager;
Splitter1: TSplitter;
RichEdit2: TRichEdit;
ControlBar1: TControlBar;
ToolBar1: TToolBar;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
ToolButton3: TToolButton;
ToolButton4: TToolButton;
ToolButton5: TToolButton;
Panel1: TPanel;
Action1: TAction;
Action2: TAction;
procedure Button1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Action2Execute(Sender: TObject);
procedure Action1Execute(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
function ToOEM(S: string): string;
function FromOEM(S: string): string;

implementation

{$R *.dfm}

//Подключение к серверу
procedure TForm1.Action1Execute(Sender: TObject);
begin
with IdTCPClient1 do
if (Connected)
then
try
Disconnect;
StatusBar1.Panels[0].Text := 'Статус: Отключен';
except
on E: Exception do
begin
ShowMessage('Ошибка VCL: ' + E.Message);
end;
end
else
try
Connect;
StatusBar1.Panels[0].Text := 'Статус: Подключен';
except
//Обработка ошибок подключения
on E: EIdException do
begin
ShowMessage('Ошибка подключения: ' + E.Message);
end;
on E: Exception do
begin
ShowMessage('Ошибка VCL: ' + E.Message);
end;
end;
end;

//Отправка сообщения
procedure TForm1.Button1Click(Sender: TObject);
begin
with IdTCPClient1 do
if (Connected)
then
try
IOHandler.WriteLn(RichEdit2.Text, enUTF8);
RichEdit1.Lines.Append(RichEdit2.Text);
RichEdit2.Lines.Clear;
except
//Обработка ошибок передачи сообщения
on E: EIdException do
begin
ShowMessage('Ошибка передачи сообщения' + E.Message);
end;
on E: Exception do
begin
ShowMessage('Ошибка VCL' + E.Message);
end;
end
else
ShowMessage('Необходимо подключиться к серверу');
end;

//Закрытие формы через меню
procedure TForm1.Action2Execute(Sender: TObject);
begin
Self.Close;
end;

//Закрытие формы
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
IdTCPClient1.Disconnect;
Action := caFree;
end;

end.




//******************//
//*Серверный модуль*//
//******************//

unit MyServer;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IdBaseComponent, IdComponent, IdCustomTCPServer, IdTCPServer,
StdCtrls, IdContext, ComCtrls, ActnCtrls, ToolWin, ActnMan, ActnMenus,
PlatformDefaultStyleActnCtrls, ActnList, IdException, IdGlobal;

type
TForm1 = class(TForm)
IdTCPServer1: TIdTCPServer;
StatusBar1: TStatusBar;
ActionMainMenuBar1: TActionMainMenuBar;
CoolBar1: TCoolBar;
ActionManager1: TActionManager;
ToolBar1: TToolBar;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
ToolButton3: TToolButton;
ToolButton4: TToolButton;
ToolButton5: TToolButton;
Action1: TAction;
Action2: TAction;
RichEdit1: TRichEdit;
procedure IdTCPServer1Execute(AContext: TIdContext);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Action2Execute(Sender: TObject);
procedure Action1Execute(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

//Активация сервера
procedure TForm1.Action1Execute(Sender: TObject);
begin
try
IdTCPServer1.Active := not IdTCPServer1.Active;
if IdTCPServer1.Active
then StatusBar1.Panels[0].Text := 'Статус: Активен'
else StatusBar1.Panels[0].Text := 'Статус: Не активен';
except
on E: EIdException do
begin
ShowMessage('Ошибка активации: ' + E.Message);
end;
on E: Exception do
begin
ShowMessage('Ошибка VCL: ' + E.Message);
end;
end;
end;

//Закрытие формы через меню
procedure TForm1.Action2Execute(Sender: TObject);
begin
Self.Close;
end;

//Закрытие формы
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
try
IdTCPServer1.Active := False;
StatusBar1.Panels[0].Text := 'Статус: Не активен';
Action := caFree;
except
end;
end;

//Обработка входящего сообщения
procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
var l: string;
begin
try
l := TrimRight(AContext.Connection.IOHandler.ReadLn(enUTF8));
RichEdit1.Lines.Append(l);
except
//Обработка ошибок получения сообщения
on E: EIdException do
begin
ShowMessage('Ошибка получения сообщения: ' + E.Message);
end;
on E: Exception do
begin
ShowMessage('Ошибка VCL: ' + E.Message);
end;
end;
end;

end.

Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.
Версия движка: 2.6+ (26.01.2011)
© 2005-2025
Текущее время: 31 октября 2025, 07:31
Выполнено за 0.02 сек.