Модераторы: Snowy, Poseidon, MetalFan
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Google Translate 
:(
    Опции темы
huismori
  Дата 19.1.2010, 21:47 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 125
Регистрация: 19.1.2010

Репутация: нет
Всего: нет
Привет всем на форуме. У меня есть вопрос о переводе Google ... Я этого проекта перевода языка, но существует проблема получения переведенного текста, как показано на картинке ...


user posted image

Код

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    IdHTTP1: TIdHTTP;
    IdCookieManager1: TIdCookieManager;
    Button1: TButton;
    Memo1: TMemo;
    Memo2: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var txt, translate        :string;
    BlockStart, BlockEnd  :integer;
begin
txt:=Memo1.text;
while Pos(' ', txt) > 0 do
 begin
 txt[Pos(' ', txt)] := '+';
 end;
translate:=IdHTTP1.Get('http://translate.google.ru/translate_t?prev=hp&hl=ru&js=y&text='+txt+'&file=&sl=en&tl=ru&history_state0=');
BlockStart:=Pos('id=result_box dir="ltr">',LowerCase(translate));
if BlockStart > 0 then
  begin
    BlockEnd:=PosEx('</div>',LowerCase(translate),BlockStart);
  end;
memo2.text:=copy(translate,BlockStart+length('id=result_box dir="ltr">'),BlockEnd-BlockStart-length('id=result_box dir="ltr">'));
end;

end.


Это сообщение отредактировал(а) huismori - 19.1.2010, 22:22

Присоединённый файл ( Кол-во скачиваний: 8 )
Присоединённый файл  Translate.rar 3,01 Kb
PM MAIL   Вверх
Keeper89
Дата 19.1.2010, 23:55 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Завсегдатай
Сообщений: 2580
Регистрация: 26.2.2009

Репутация: 6
Всего: 58
huismori, если ошибка в ????????????
то
Код

translate := Utf8ToAnsi(IdHTTP1.Get(...));



--------------------
Cogito, ergo sum

Keeper's blog
CnWizards Downloads

user posted image
PM MAIL WWW   Вверх
huismori
Дата 19.1.2010, 23:59 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 125
Регистрация: 19.1.2010

Репутация: нет
Всего: нет
не повезло  smile 

Код

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    IdHTTP1: TIdHTTP;
    IdCookieManager1: TIdCookieManager;
    Button1: TButton;
    Memo1: TMemo;
    Memo2: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var txt, translate        :string;
    BlockStart, BlockEnd  :integer;
begin
txt:=Memo1.text;
while Pos(' ', txt) > 0 do
 begin
 txt[Pos(' ', txt)] := '+';
 end;
translate:=Utf8ToAnsi(IdHTTP1.Get('http://translate.google.com.tr/#en|ru|'+txt));
BlockStart:=Pos('id=result_box dir="ltr">',LowerCase(translate));
if BlockStart > 0 then
  begin
    BlockEnd:=PosEx('</div>',LowerCase(translate),BlockStart);
  end;
memo2.text:=copy(translate,BlockStart+length('id=result_box dir="ltr">'),BlockEnd-BlockStart-length('id=result_box dir="ltr">'));
end;

end.


Это сообщение отредактировал(а) huismori - 20.1.2010, 00:04
PM MAIL   Вверх
Keeper89
Дата 20.1.2010, 00:04 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Завсегдатай
Сообщений: 2580
Регистрация: 26.2.2009

Репутация: 6
Всего: 58
Цитата(huismori @  19.1.2010,  23:59 Найти цитируемый пост)
не повезло  smile 

Ну, не повезло, так не повезло, телепатор у меня дальше не работает.


--------------------
Cogito, ergo sum

Keeper's blog
CnWizards Downloads

user posted image
PM MAIL WWW   Вверх
muratboy31
Дата 20.1.2010, 00:09 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


Профиль
Группа: Участник
Сообщений: 230
Регистрация: 7.1.2010

Репутация: нет
Всего: нет
ok i found something for u but i really dont know how to make it project but i am sure professianols in the forum will definitely help u...

It requires the Synapse internet classes (http://www.ararat.cz/synapse/doku.php)

Код

Unit translator_unit;
{$IFDEF FPC}
{$MODE DELPHI} {$H+}
{$ENDIF}
Interface

Const
{..............................................................................}

//    cLanguagePair_ = 0;
    cLanguagePair_EnglishToFrench  = 2;
    cLanguagePair_EnglishToGerman  = 3;
    cLanguagePair_EnglishToItalian = 4;
//    cLanguagePair_ = 5;
//    cLanguagePair_ = 6;
//    cLanguagePair_ = 7;
//    cLanguagePair_ = 8;
//    cLanguagePair_ = 9;
//    cLanguagePair_ = 10;
//    cLanguagePair_ = 11;
//    cLanguagePair_ = 12;
    cLanguagePair_ItalianToEnglish = 13;
//    cLanguagePair_ = 14;
//    cLanguagePair_ = 15;
//    cLanguagePair_ = 16;
//    cLanguagePair_ = 17;

    cLanguagePairList : Array[0..17] Of AnsiString =(
        'zh-CN%7Cen',
        'en%7Czh-CN',
        'en%7Cfr',
        'en%7Cde',
        'en%7Cit',
        'en%7Cja',
        'en%7Cko',
        'en%7Cpt',
        'en%7Ces',
        'fr%7Cen',
        'fr%7Cde',
        'de%7Cen',
        'de%7Cfr',
        'it%7Cen',
        'ja%7Cen',
        'ko%7Cen',
        'pt%7Cen',
        'es%7Cen'
    );
{..............................................................................}

{..............................................................................}
Function  TranslateText(Const ATextIn        : AnsiString;
                        Var   ATextOut       : AnsiString;
                        Const ALanguagePair  : Integer) : Boolean;
                        
Implementation

Uses
    Classes,
    httpsend,
    SysUtils;
    
{..............................................................................}

{..............................................................................}
Function  HTTPEncode(Const AStr : AnsiString) : AnsiString;
Const
    cNoConversion = ['A'..'Z', 'a'..'z', '*', '@', '.', '_', '-'];
Var
    Sp, Rp : PChar;
Begin
    SetLength(Result, Length(AStr) * 3);
    Sp := PChar(AStr);
    Rp := PChar(Result);
    While Sp^ <> #0 Do
    Begin
        If Sp^ in cNoConversion Then
            Rp^ := Sp^
        Else
        If Sp^ = ' ' Then
            Rp^ := '+'
        Else
        Begin
            FormatBuf(Rp^, 3, '%%%.2x', 6, [Ord(Sp^)]);
            Inc(Rp, 2);
        End;
        Inc(Rp);
        Inc(Sp);
    End;
    SetLength(Result, Rp - PChar(Result));
End;
{..............................................................................}

{..............................................................................}
Function PosEx(Const SubStr, S : AnsiString; Offset : Cardinal) : Integer;

Var
    i : PChar;
Begin
    If (offset <1> length(s)) Then
    Begin
        Result := 0;
        Exit
    End;

    i := StrPos(@s[offset],@substr[1]);
    If i = Nil Then
        PosEx := 0
    Else
        PosEx := Succ(i-PChar(s));
End;
{..............................................................................}

{..............................................................................}
Function  TranslateText(Const ATextIn        : AnsiString;
                        Var   ATextOut       : AnsiString;
                        Const ALanguagePair  : Integer) : Boolean;
Var
    SendTxt  : AnsiString;
    Response : TStringList;
    s        : AnsiString;
    a,b      : integer;
Begin
      Result   := False;
      Response := TStringList.Create;
      Try
          SendTxt := 'http://translate.google.com/translate_t?text=' +
                     HTTPEncode(ATextIn) +
                     '&langpair=' +
                     cLanguagePairList[ALanguagePair];

          If Not HttpGetText(SendTxt,Response) Then Exit;
          s := Response.Text;
          a := PosEx('>',s,Pos('id=suggestion>',s));
          b := PosEx('</textarea>',s,a);
          ATextOut := Copy(s,a+1,b-a-1);
          Result := True;
      Finally
          Response.Free;
      End;
End;
{..............................................................................}

{..............................................................................}
End.
PM MAIL   Вверх
  
 Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Сети"
Snowy
Poseidon
MetalFan

Запрещено:

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делится вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи

Если Вам помогли и атмосфера форума Вам понравилась, то заходите к нам чаще! С уважением, Snowy, Poseidon, MetalFan.
 
1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Сети | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.1350 ]   [ Использовано запросов: 21 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.