API Google Speak

Funciones Sin comentarios »
nov 302010

Esta función sirve para utilizar el API Speak de Google, con la cual podemos llevar un texto a voz de máquina, esta api sólo se limita a cien caracteres, y por supuesto necesitamos de internet para que funcione.
El primer parámetro es el texto que queremos escuchar, el segundo el idioma o mejor dicho la pronunciación, en el caso de español es “es” para otros por ejemplo:

Alemán: de
Danés: da
Español: es
Finlandia: fi
Francés: fr
Inglés: en
Italiano: it
Neerlandés: nl
Polaco: pl
Portugués: pt
Sueco: sv

y el tercer parámetro es para llamar a DoEvents si es que lo deseamos.

Option Explicit
'-----------------------------------------------------------------------------------------------------
'Autor: Leandro Ascierto
'Web: www.leandroascierto.com.ar
'Abreviaturas
'de, da, es, fi, fr, en, it, nl, pl, pt, sv"
'Alemán , Danés, Español, Finlandia, Francés, Inglés, Italiano, Neerlandés, Polaco, Portugués, Sueco
'----------------------------------------------------------------------------------------------------
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

Public Function GoogleSpeak(ByVal sText As String, Optional ByVal Language As String = "es", Optional ByVal bDoevents As Boolean) As Boolean
    On Error Resume Next
    Dim sTempPath As String, ml As String
    Dim FileLength As Long

    sText = Replace(sText, vbCrLf, " ")

    If Len(sText) > 100 Then Exit Function

    sTempPath = Environ("Temp") & "\TempMP3.MP3"

    If URLDownloadToFile(0&, "http://translate.google.com/translate_tts?tl=" & Language & "&q=" & sText, sTempPath, 0&, 0&) = 0 Then

        If mciSendString("open " & Chr$(34) & sTempPath & Chr$(34) & " type MpegVideo" & " alias myfile", 0&, 0&, 0&) = 0 Then

            ml = String(30, 0)
            Call mciSendString("status myfile length ", ml, 30, 0&)
            FileLength = Val(ml)
            If FileLength Then
                If mciSendString("play myFile", 0&, 0&, 0&) = 0 Then
                    Do While mciSendString("status myfile position ", ml, 30, 0&) = 0
                        If Val(ml) = FileLength Then GoogleSpeak = True: Exit Do
                        If bDoevents Then DoEvents
                    Loop
                End If
            End If
            Call mciSendString("close myfile", 0&, 0&, 0&)

        End If

        Kill sTempPath
    End If

End Function

Private Sub Command1_Click()
   Debug.Print GoogleSpeak("Antes era sexo droga y rock and roll, ahora es paja mate y chamame", "es", True)
End Sub
Publicado por admin a las 15:23 Etiquetas con:

Comprimir y Descomprimir un Array de bits

Funciones Sin comentarios »
ago 052009

Estas dos funciones sirven para comprimir y descomprimir un array de una forma muy rápida y según el caso puede reducirle el tamaño hasta 10 veces, esto depende del tamaño del mismo o si los datos que este contengan no están comprimidos (por ejemplo no comprimirá el array de una imágen .JPG o un archivo .ZIP, si de una imágen BMP un archivo .EXE). las funciones utilizan las Apis de NTDLL.DLL

* Nota:  Algunos antivirus detectan estas Apis como una posible amenaza, es un dato para tener en cuenta si alguna vez la aplicación es marcada como un virus.

Option Explicit
Private Declare Function RtlGetCompressionWorkSpaceSize Lib "NTDLL" (ByVal flags As Integer, WorkSpaceSize As Long, UNKNOWN_PARAMETER As Long) As Long
Private Declare Function NtAllocateVirtualMemory Lib "ntdll.dll" (ByVal ProcHandle As Long, BaseAddress As Long, ByVal NumBits As Long, regionsize As Long, ByVal flags As Long, ByVal ProtectMode As Long) As Long
Private Declare Function RtlCompressBuffer Lib "NTDLL" (ByVal flags As Integer, ByVal BuffUnCompressed As Long, ByVal UnCompSize As Long, ByVal BuffCompressed As Long, ByVal CompBuffSize As Long, ByVal UNKNOWN_PARAMETER As Long, OutputSize As Long, ByVal WorkSpace As Long) As Long
Private Declare Function RtlDecompressBuffer Lib "NTDLL" (ByVal flags As Integer, ByVal BuffUnCompressed As Long, ByVal UnCompSize As Long, ByVal BuffCompressed As Long, ByVal CompBuffSize As Long, OutputSize As Long) As Long
Private Declare Function NtFreeVirtualMemory Lib "ntdll.dll" (ByVal ProcHandle As Long, BaseAddress As Long, regionsize As Long, ByVal flags As Long) As Long

Public Function Compress(Data() As Byte, Out() As Byte) As Long
    Dim WorkSpaceSize As Long
    Dim WorkSpace As Long
    ReDim Out(UBound(Data) * 1.13 + 4)

    RtlGetCompressionWorkSpaceSize 2, WorkSpaceSize, 0
    NtAllocateVirtualMemory -1, WorkSpace, 0, WorkSpaceSize, 4096, 64
    RtlCompressBuffer 2, VarPtr(Data(0)), UBound(Data) + 1, VarPtr(Out(0)), (UBound(Data) * 1.13 + 4), 0, Compress, WorkSpace
    NtFreeVirtualMemory -1, WorkSpace, 0, 16384
    ReDim Preserve Out(Compress)
End Function

Public Function DeCompress(Data() As Byte, dest() As Byte) As Long
    If UBound(Data) Then
        Dim lBufferSize As Long
        ReDim dest(UBound(Data) * 12.5)
        RtlDecompressBuffer 2, VarPtr(dest(0)), (UBound(Data) * 12.5), VarPtr(Data(0)), UBound(Data), lBufferSize
        If lBufferSize Then
            ReDim Preserve dest(lBufferSize - 1)
            DeCompress = lBufferSize - 1
        End If
    End If
End Function

Publicado por admin a las 8:12 Etiquetas con:
© 2012 Leandro Ascierto Suffusion theme by Sayontan Sinha