Delphi調用百度語言合成Api

unit Unit3;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Idhttp,
  IdMultipartFormData, IdBaseComponent, IdComponent, IdIOHandler,
  IdIOHandlerSocket, IdIOHandlerStack, IdSSL, IdSSLOpenSSL, Httpapp,
  System.JSON, NB30, mmsystem;

type
  TForm3 = class(TForm)
    Label1: TLabel;
    Edit1: TEdit;
    Edit2: TEdit;
    Label2: TLabel;
    ComboBox1: TComboBox;
    Label3: TLabel;
    Label4: TLabel;
    ComboBox2: TComboBox;
    Label5: TLabel;
    ComboBox3: TComboBox;
    Label6: TLabel;
    ComboBox4: TComboBox;
    Label7: TLabel;
    ComboBox5: TComboBox;
    Edit3: TEdit;
    Label8: TLabel;
    Button1: TButton;
    Button2: TButton;
    Memo1: TMemo;
    IdSSLIOHandlerSocketOpenSSL1: TIdSSLIOHandlerSocketOpenSSL;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    access_token: String;
    session_key: String;
    refresh_token: String;
    session_secret: String;
    expires_in: String;
  end;

var
  Form3: TForm3;

implementation

{$R *.dfm}

function GetAdaPterInfo(lana: AnsiChar): string;
var
  Adapter: TAdapterStatus;
  NCB: TNCB;
begin
  FillChar(NCB, Sizeof(NCB), 0);
  NCB.ncb_command := Char(NCBRESET);
  NCB.ncb_lana_num := lana;
  if Netbios(@NCB) <> Char(NRC_GOODRET) then
  begin
    Result := 'mac not found';
    exit;
  end;
  FillChar(NCB, Sizeof(NCB), 0);
  NCB.ncb_command := Char(NCBASTAT);
  NCB.ncb_lana_num := lana;
  NCB.ncb_callname := '*';

  FillChar(Adapter, Sizeof(Adapter), 0);
  NCB.ncb_buffer := @Adapter;
  NCB.ncb_length := Sizeof(Adapter);
  if Netbios(@NCB) <> Char(NRC_GOODRET) then
  begin
    Result := 'mac not found';
    exit;
  end;
  Result := IntToHex(Byte(Adapter.adapter_address[0]), 2) + '_' +
    IntToHex(Byte(Adapter.adapter_address[1]), 2) + '_' +
    IntToHex(Byte(Adapter.adapter_address[2]), 2) + '_' +
    IntToHex(Byte(Adapter.adapter_address[3]), 2) + '_' +
    IntToHex(Byte(Adapter.adapter_address[4]), 2) + '_' +
    IntToHex(Byte(Adapter.adapter_address[5]), 2);
end;

function GetMACAddress: string;
var
  AdapterList: TLanaEnum;
  NCB: TNCB;
begin
  FillChar(NCB, Sizeof(NCB), 0);
  NCB.ncb_command := Char(NCBENUM);
  NCB.ncb_buffer := @AdapterList;
  NCB.ncb_length := Sizeof(AdapterList);
  Netbios(@NCB);
  if Byte(AdapterList.length) > 0 then
    Result := GetAdaPterInfo(AdapterList.lana[0])
  else
    Result := 'mac not found';
end;

procedure TForm3.Button1Click(Sender: TObject);
var
  HttpClient: TIdHttp;
  postStream: TIdMultiPartFormDataStream;
  ss: TStringStream;
  HttpResult: String;
  ConJson: TJSONObject;
begin
  if (Edit1.Text = '') or (Edit2.Text = '') then
    exit;
  HttpClient := TIdHttp.Create();
  HttpClient.IOHandler := IdSSLIOHandlerSocketOpenSSL1;
  postStream := TIdMultiPartFormDataStream.Create;
  ss := TStringStream.Create('', TEncoding.UTF8);

  try
    postStream.AddFormField('grant_type', 'client_credentials');
    postStream.AddFormField('client_id', Edit1.Text);
    postStream.AddFormField('client_secret', Edit2.Text);
    try
      HttpClient.Post('https://openapi.baidu.com/oauth/2.0/token',
        postStream, ss);
      HttpResult := ss.DataString;
      ConJson := TJSONObject.ParseJSONValue(TEncoding.UTF8.GetBytes(HttpResult),
        0) as TJSONObject;
      if ConJson.GetValue('access_token') <> nil then
      begin
        access_token := ConJson.GetValue('access_token').Value;
        session_key := ConJson.GetValue('session_key').Value;
        refresh_token := ConJson.GetValue('refresh_token').Value;
        session_secret := ConJson.GetValue('session_secret').Value;
        expires_in := ConJson.GetValue('expires_in').Value;
        Button2.Enabled := true;
        Memo1.Lines.Add('初始化成功');
      end;
    except
      on e: Exception do
      begin
        Memo1.Lines.Add(e.ToString);
        exit;
      end;
    end;
  finally
    HttpClient.Free;
    postStream.Free;
    ss.Free;
  end;
end;

procedure TForm3.Button2Click(Sender: TObject);
var
  HttpClient: TIdHttp;
  PostData: TStringStream;
  MyStream: TMemoryStream;
  ss: TStringStream;
  HttpResult: String;
  ConJson: TJSONObject;
  str: String;
  s: AnsiString;
  p: PAnsiChar;
begin
  if Edit3.Text = '' then
  begin
    exit;
  end;
  str := '';
  MyStream := TMemoryStream.Create;
  HttpClient := TIdHttp.Create();
  HttpClient.IOHandler := IdSSLIOHandlerSocketOpenSSL1;
  ss := TStringStream.Create('', TEncoding.UTF8);
  try
    // 合成的文本，使用UTF-8編碼。小於2048箇中文字或者英文數字。（文本在百度服務器內轉換爲GBK後，長度必須小於4096字節）
    str := 'tex=' + HttpEncode(HttpEncode(UTF8Encode(Edit3.Text)));
    // 開放平臺獲取到的開發者access_token（見上面的“鑑權認證機制”段落）
    str := str + '&tok=' + access_token + '&cuid=' + GetMACAddress + '&ctp=1';
    str := str + '&lan=zh&spd=' + ComboBox1.Text + '&pit=' + ComboBox2.Text;
    str := str + '&vol=' + ComboBox3.Text + '&per=' +
      inttostr(ComboBox4.ItemIndex);
    if ComboBox5.ItemIndex = 0 then
    begin
      str := str + '&aue=3';
    end
    else
    begin
      str := str + '&aue=6';
    end;
    try
      // PostData := TStringStream.Create('str', TEncoding.UTF8);
      // HttpClient.Post('https://tsn.baidu.com/text2audio', PostData, ss);
      HttpClient.Get('https://tsn.baidu.com/text2audio?' + str, MyStream);
      HttpResult := HttpClient.Response.ContentType;
      if HttpResult.Contains('audio') then
      begin
        MyStream.SaveToFile('tts_sample.' + ComboBox5.Text);
        Memo1.Lines.Add('合成成功');
      end
      else
      begin
        GetMem(p, MyStream.Size + 1);
        FillChar(p^, MyStream.Size, 0);
        Move(MyStream.Memory^, p^, MyStream.Size);
        s := p;
        FreeMem(p);
        Memo1.Lines.Add(s);
      end;

    except
      on e: Exception do
      begin
        Memo1.Lines.Add(e.ToString);
        exit;
      end;
    end;
  finally
    if PostData <> nil then
    begin
      PostData.Free;
    end;
    HttpClient.Free;
    ss.Free;
    MyStream.Free;
  end;
  str := ExtractFilePath(ParamStr(0)) + 'tts_sample.' + ComboBox5.Text;
  if (FileExists(str)) and (ComboBox5.Text = 'wav') then
  begin
    sndPlaySound(Pchar(str), SND_ASYNC OR SND_NOWAIT);
  end;
end;

procedure TForm3.FormCreate(Sender: TObject);
var
  I: integer;
begin
  ComboBox1.Clear;
  ComboBox2.Clear;
  ComboBox3.Clear;
  for I := 0 to 15 do
  begin
    ComboBox1.Items.Add(inttostr(I));
    ComboBox2.Items.Add(inttostr(I));
    ComboBox3.Items.Add(inttostr(I));
  end;
  ComboBox1.ItemIndex := 5;
  ComboBox2.ItemIndex := 5;
  ComboBox3.ItemIndex := 5;

end;

end.