delphi Google Text To Speech API

unit uGTTS;

interface

uses

Windows, SysUtils, Variants, Classes, StrUtils, IdHTTP, HTTPApp, IdURI,

ShellAPI, DateUtils, Forms, MPlayer, Controls;

const

LANG_TR = 'tr';

LANG_EN = 'en';

LANG_DE = 'de';

LANG_RU = 'ru';

LANG_FR = 'fr';

Type

///

/// Google Text To Speech API si yardımı ile yazıları sese çeviren kütüphanedir.

/// Verilen yazıyı MP3 formatında geri gönderir. Ön bellekleme mekanizması ise

/// daha önce sorgulanmış yazıları google'a yollamadan önce ön bellek klasöründe arar.

/// Yazının ses karşılığı daha önce oluşturulmuş ise google servislerine istemde bulunmaz.

/// Bu özellik varsayılan açıktır. İstenirse devre dışı bırakılabilir.

///

/// Bu sınıf Ahmet ALTAY tarafından Google Text To Speech kullanılarak geliştirilmiştir. Tarih: 16.06.2014

///

TGTTS = Class(TComponent)

private const

sURL: string = 'http://translate.google.com/translate_tts?ie=utf-8&tl=%s&q=%s';

sTimeOut: Integer = 3000; // 3 second

private

{ Private declarations }

FTempPath: string;

FUseCache: Boolean;

FLanguage: string;

FAppDir: string;

FSpeechDir: string;

FLastCalledURL: String;

FLastConvertedMp3: String;

FMediaPlayer: TMediaPlayer;

function DelTree(const ADirName: string): Boolean;

public

///

/// Parametre ile verilen yazıyı, ses dosyasına dönüştürür.

///

/// Metin (100 karakteri geçmemesi tavsiye edilir.)

/// MP3 formatında dosya yolu döner.

///

/// Bu fonskyion Google servisleri aracılığı ile geliştirilmiştir. http://translate.google.com

///

/// Klasör okuma/yazma izni yok veya dosya yolu hatalı.

/// Bağlantı hatası, İnternet erişimi yok veya yasaklı URL.

/// Ahmet ALTAY

function TextToSpeech(const AText: string): TFileName;

///

/// Parametre ile verilen yazıyı, ses dosyasına dönüştürür ve MediaPlayer ile çalar.

///

/// Metin (100 karakteri geçmemesi tavsiye edilir.)

/// Ses dosyasının yürütüleceği media player nesnesi.

/// Media player'ın, dosya yürütme işlemini bitirene kadar beklemesi için true gönderin.

///

/// Bu fonskyion Google servisleri aracılığı ile geliştirilmiştir. http://translate.google.com

///

/// Klasör okuma/yazma izni yok veya dosya yolu hatalı.

/// Bağlantı hatası, İnternet erişimi yok veya yasaklı URL.

/// Media Player hatası, codec yok, dosya yolu hatalı veya erişim izni yok.

/// Ahmet ALTAY

procedure SpeechNow(const AText: string; const AMediaPlayer: TMediaPlayer; const ADontStopWhilePlaying: Boolean = True); overload;

///

/// Parametre ile verilen yazıyı, ses dosyasına dönüştürür ve MediaPlayer ile çalar.

///

/// Metin (100 karakteri geçmemesi tavsiye edilir.)

/// Media player'ın, dosya yürütme işlemini bitirene kadar beklemesi için true gönderin.

///

/// Bu fonskyion Google servisleri aracılığı ile geliştirilmiştir. http://translate.google.com

///

/// Klasör okuma/yazma izni yok veya dosya yolu hatalı.

/// Bağlantı hatası, İnternet erişimi yok veya yasaklı URL.

/// Media Player hatası, codec yok, dosya yolu hatalı veya erişim izni yok.

/// Ahmet ALTAY

procedure SpeechNow(const AText: string; const ADontStopWhilePlaying: Boolean = True); overload;

///

/// Okutulan dosyanın işi bittikten sonra silmek için kullanılabilir.

///

/// İşlem başarılı ise True, değilse False döner.

/// Ahmet ALTAY

function DeleteFile(const AFileName: string): Boolean;

///

/// Ön bellekte biriken dosyaları temizlemek için kullanılır.

///

/// İşlem başarılı ise True, değilse False döner.

/// Ahmet ALTAY

function ClearCache(): Boolean;

/// Ses çevirisinde kullanılacak olan dil seçeneği.

/// Ön bellek kullanımı.

/// Ahmet ALTAY

constructor Create(AOwner: TWinControl; const ALanguage: string = LANG_TR; const AUseCache: Boolean = True); overload;

/// Dosyaların kayıt edileceği kök klasor yolu.

/// Ses çevirisinde kullanılacak olan dil seçeneği.

/// Ön bellek kullanımı.

/// Ahmet ALTAY

constructor Create(AOwner: TWinControl; const ATempPath: string; const ALanguage: string = LANG_TR; const AUseCache: Boolean = True); overload;

/// Dosyaların kayıt edileceği kök klasor yolu.

/// Temp içersine açılacak uygulamayı temsil eden klasör adı.

/// Uygulama klasörü içine açılacak. Ses dosyalarını içeren klasör adı.

/// Ses çevirisinde kullanılacak olan dil seçeneği.

/// Ön bellek kullanımı.

/// Ahmet ALTAY

constructor Create(AOwner: TWinControl; const ATempPath: string; const AAppDir: string; const ASpeechDir: string; const ALanguage: string = LANG_TR; const AUseCache: Boolean = True); overload;

destructor Destroy; override;

///

Son çalıştırılan URL. ReadOnly

property LastCalledURL: String read FLastCalledURL;

///

Son dönüştürülen MP3 dosyası. ReadOnly

property LastConvertedMp3: String read FLastConvertedMp3;

end;

implementation

{ TGTTS }

constructor TGTTS.Create(AOwner: TWinControl; const ALanguage: string; const AUseCache: Boolean);

var

lTempPath: array[0..MAX_PATH] of Char;

lAppDir: String;

begin

GetTempPath(Length(lTempPath), lTempPath);

lAppDir := ReplaceStr(ExtractFileName(Application.ExeName),ExtractFileExt(Application.ExeName),'');

Create(AOwner,lTempPath,lAppDir,'Speech',ALanguage,AUseCache);

end;

constructor TGTTS.Create(AOwner: TWinControl; const ATempPath, ALanguage: string; const AUseCache: Boolean);

var

lAppDir: String;

begin

lAppDir := ReplaceStr(ExtractFileName(Application.ExeName),ExtractFileExt(Application.ExeName),'');

Create(AOwner,ATempPath,ExtractFileName(Application.ExeName),'Speech',ALanguage,AUseCache);

end;

constructor TGTTS.Create(AOwner: TWinControl; const ATempPath, AAppDir, ASpeechDir, ALanguage: string; const AUseCache: Boolean);

begin

inherited Create(AOwner);

FTempPath := ATempPath;

FAppDir := AAppDir;

FSpeechDir := ASpeechDir;

FUseCache := AUseCache;

FLanguage := ALanguage;

FMediaPlayer := TMediaPlayer.Create(Self);

FMediaPlayer.Parent := TWinControl(Self.Owner);

FMediaPlayer.Visible := False;

FMediaPlayer.Close;

end;

function TGTTS.ClearCache: Boolean;

begin

if not DirectoryExists(FTempPath + FAppDir + '\' + FSpeechDir + '\') then

begin

Result := True;

Exit;

end;

FMediaPlayer.Close;

Result := DelTree(FTempPath + FAppDir + '\' + FSpeechDir + '\');

end;

function TGTTS.DeleteFile(const AFileName: string): Boolean;

begin

Result := False;

if FileExists(AFileName) then

Result := SysUtils.DeleteFile(AFileName);

end;

function TGTTS.DelTree(const ADirName: string): Boolean;

var

lSHFileOpStruct: TSHFileOpStruct;

lDirBuf: array[0..MAX_PATH] of char;

begin

try

Fillchar(lSHFileOpStruct, Sizeof(lSHFileOpStruct), 0);

FillChar(lDirBuf, Sizeof(lDirBuf), 0);

StrPCopy(lDirBuf, ADirName);

with lSHFileOpStruct do

begin

Wnd := 0;

pFrom := @lDirBuf;

wFunc := FO_DELETE;

fFlags := FOF_NOCONFIRMATION or FOF_SILENT;

end;

Result := SHFileOperation(lSHFileOpStruct) = 0;

except

Result := False;

end;

destructor TGTTS.Destroy;

begin

FMediaPlayer.Close;

FreeAndNil(FMediaPlayer);

inherited Destroy;

end;

procedure TGTTS.SpeechNow(const AText: string; const ADontStopWhilePlaying: Boolean);

begin

SpeechNow(AText,FMediaPlayer,ADontStopWhilePlaying);

end;

procedure TGTTS.SpeechNow(const AText: string; const AMediaPlayer: TMediaPlayer; const ADontStopWhilePlaying: Boolean);

var

lFileName: TFileName;

begin

lFileName := TextToSpeech(AText);

if not FileExists(lFileName) then

Exit;

with AMediaPlayer do

begin

Close;

FileName := lFileName;

Open;

Play;

if ADontStopWhilePlaying then

begin

while Mode = mpPlaying do

Application.ProcessMessages;

Stop;

Close;

end;

function TGTTS.TextToSpeech(const AText: String): TFileName;

var

lHttp: TIdHTTP;

lStream: TMemoryStream;

lUrl, lFileName: string;

lTempFile: array[0..MAX_PATH] of Char;

begin

Result := '';

if FUseCache then

begin

if not DirectoryExists(FTempPath + FAppDir) then

CreateDirectory(PWideChar(FTempPath + FAppDir), nil);

if not DirectoryExists(FTempPath + FAppDir + '\' + FSpeechDir) then

CreateDirectory(PWideChar(FTempPath + FAppDir + '\' + FSpeechDir), nil);

lFileName := FTempPath + FAppDir + '\' + FSpeechDir + '\' + AText + ' [' +FLanguage+ '].mp3'

end

else

begin

GetTempFileName(PWideChar(FTempPath), 'tts', 0, lTempFile);

lFileName := ChangeFileExt(lTempFile, '.mp3');

end;

if (not FUseCache) or (not FileExists(lFileName)) then

begin

lStream := TMemoryStream.Create;

try

lUrl := TIdURI.URLEncode(Format(sURL, [FLanguage, AText]));

FLastCalledURL := lUrl;

lHttp := TIdHTTP.Create(nil);

try

lHttp.ConnectTimeout := sTimeOut;

lHttp.ReadTimeout := sTimeOut;

lHttp.Request.AcceptCharSet := 'UTF-8';

lHttp.Get(lUrl, lStream);

finally

FreeAndNil(lHttp);

end;

if lStream.Size > 0 then

begin

lStream.Seek(0, 0);

lStream.SaveToFile(lFileName);

end;

finally

FreeAndNil(lStream);

end;

if FileExists(lFileName) then

begin

Result := lFileName;

FLastConvertedMp3 := lFileName;

end;

end.

用法：

procedure TForm1.Button1Click(Sender: TObject);

var

lGtts: TGTTS;

begin

lGtts := TGTTS.Create(Self);

try

lGtts.SpeechNow('www.delphitop.com');

finally

FreeAndNil(lGtts);

end;

推荐分享