REM ***** BASIC ***** REM Firma para Thunderbird REM Const cVersion = "1.0" Dim oDialogo As Object Dim rutalogo as string Dim rutalogoOD as String Dim cTextNom as String Dim cTextCarrec as String Dim cTextDepart as String Dim cTextDireccio as String Dim cTextTel as String Dim cTextCorreu as String Dim rutafirma As String Private Const BIT_INT_CLIPBOARD_ACCESS_LATENCY = 50 'es necesaria para pegar en el portapapeles /is necessary to paste the clipboard Global BIT_sTxtClipBoardString As String Sub Main Dim oControl as Object Dim oDialogoModelo As Object Dim oLogo As Object ' Select Case GetGUIType() ' windows Case 1 rutafirma = Environ("USERPROFILE") ' unix Case 4 rutafirma = Environ("HOME") Case Else msgbox("Sistema operatiu no suportat, ho sentim :(") exit sub End Select ' DialogLibraries.LoadLibrary("mGVA") oDialogo=createUnoDialog(DialogLibraries.mGVA.DialogFirma) ' 'Accedemos al modelo del objeto oDialogoModelo = oDialogo.getModel() With oDialogoModelo .Title = "Generador de firma para Thunderbird v" & cVersion ' .ImageURL = ConvertToUrl("E:\generalitat.png") 'Imagen de fondo End With ' oControl = oDialogo.getControl("fcLogoEst") oControl.Text = ConvertFromURL(ruta) oControl = oDialogo.getControl("fcLogoOD") oControl.Text = ConvertFromURL(ruta) 'Carga variables si existen CarregaVariables ' Unlogo ' oDialogo.execute() oDialogo.dispose() End Sub Function CarregaVariables as boolean Dim NombreArchivo As String DIM lCas as boolean Dim LineaActual As String Dim Msg As String Dim nLinea Dim mDatos(6) as string On Error GoTo ErrorCarregaVariables nLinea=0 NombreArchivo = rutafirma & "/dadesfirma.txt" ' Create the SimpleFileAccess service. oSFA = CreateUnoService("com.sun.star.ucb.SimpleFileAccess") 'Create the Specialized stream. oTextStream = CreateUnoService("com.sun.star.io.TextInputStream") ' Abre el archivo (modo de lectura) NumArchivo = oSFA.openFileRead(ConvertToURL(NombreArchivo)) oTextStream.SetInputStream(NumArchivo) oTextStream.setEncoding("ISO-8859-15") ' Verifica cuando se ha alcanzado el final del archivo Do While not oTextStream.isEOF() ' Lee una línea i lleva els bots de carro per si estem en linux LineaActual=Replace(oTextStream.readline(),chr(10),"") If len(LineaActual)<>0 Then mDatos(nLinea)=LineaActual nLinea=nLinea+1 endif Loop ' Cierra el archivo oTextStream.closeInput() ReDim Preserve mDatos(nLinea-1) oControl=oDialogo.getControl("TextNom") oControl.Text = mDatos(0) cTextNom = mDatos(0) ' oControl=oDialogo.getControl("TextCarrec") oControl.Text = mDatos(1) cTextCarrec = mDatos(1) ' oControl=oDialogo.getControl("TextDepart") oControl.Text = mDatos(2) cTextDepart = mDatos(2) ' oControl=oDialogo.getControl("TextDireccio") oControl.Text = mDatos(2) cTextDireccio = mDatos(3) ' oControl=oDialogo.getControl("TextTel") oControl.Text = mDatos(4) cTextTel = mDatos(4) ' oControl=oDialogo.getControl("TextCorreu") oControl.Text = mDatos(5) cTextCorreu = mDatos(5) GoTo FinErrorCarregaVariables ErrorCarregaVariables: CarregaVariables=False ' Informar sobre el error 'MsgBox "Problema llegint el fitxer de datosfirma, és possible que la macro estiga mal configurada o que el format del fitxer siga incorrecte.", MB_ICONEXCLAMATION, "Error" ' Terminar la ejecución de la macro 'End FinErrorCarregaVariables: ' Desactivar tratamiento de errores On Error GoTo 0 CarregaVariables=True End Function Function GuardarVariables as boolean Dim NombreArchivo As String DIM lCas as boolean Dim LineaActual As String Dim Msg As String On Error GoTo ErrorGuardarVariables NombreArchivo = rutafirma & "/dadesfirma.txt" ' Create the SimpleFileAccess service. oSFA = CreateUnoService("com.sun.star.ucb.SimpleFileAccess") 'Create the Specialized stream. oTextStream = CreateUnoService("com.sun.star.io.TextOutputStream") ' Abre el archivo (modo de lectura) NumArchivo = oSFA.openFileWrite(ConvertToURL(NombreArchivo)) oTextStream.setOutputStream(NumArchivo) oTextStream.setEncoding("ISO-8859-15") ' Write the strings. oTextStream.writeString(cTextNom & CHR$(13) & CHR$(10)) oTextStream.writeString(cTextCarrec & CHR$(13) & CHR$(10)) oTextStream.writeString(cTextDepart & CHR$(13) & CHR$(10)) oTextStream.writeString(cTextDireccio & CHR$(13) & CHR$(10)) oTextStream.writeString(cTextTel & CHR$(13) & CHR$(10)) oTextStream.writeString(cTextCorreu & CHR$(13) & CHR$(10)) ' Cierra el archivo oTextStream.closeOutput() GoTo FinErrorGuardarVariables ErrorGuardarVariables: GuardarVariables=False ' Informar sobre el error 'MsgBox "Problema llegint el fitxer de datosfirma, és possible que la macro estiga mal configurada o que el format del fitxer siga incorrecte.", MB_ICONEXCLAMATION, "Error" ' Terminar la ejecución de la macro 'End FinErrorGuardarVariables: ' Desactivar tratamiento de errores On Error GoTo 0 GuardarVariables=True End Function Sub CambiarVista Dim oCheckB as object Dim oControl as object oControl = oDialogo.getControl("fcLogoOD") oCheckB = oDialogo.getControl("CheckBox1") if oCheckB.getModel.State = 1 then DosLogo oControl.getModel.Enabled = TRUE else UnLogo oControl.getModel.Enabled = FALSE end if End Sub Sub UnLogo Dim oEti9 As Object Dim oLogo2 As Object Dim oControl2 As Object Dim nAmple as Integer Dim nPosX as Integer ' nAmple = 260 nPosX = 105 ' oEti9 = oDialogo.getControl("LabelNom") With oEti9.getModel .Width = nAmple .positionX = nPosX End With oEti9 = oDialogo.getControl("LabelCarrec") With oEti9.getModel .Width = nAmple .positionX = nPosX End With oEti9 = oDialogo.getControl("LabelDepart") With oEti9.getModel .Width = nAmple .positionX = nPosX End With oEti9 = oDialogo.getControl("LabelDireccio") With oEti9.getModel .Width = nAmple .positionX = 105 End With oEti9 = oDialogo.getControl("LabelTel") With oEti9.getModel .Width = nAmple .positionX = nPosX End With oEti9 = oDialogo.getControl("LabelCorreu") With oEti9.getModel .Width = nAmple .positionX = nPosX End With oLogo2 = oDialogo.getControl("ImageControl3") oLogo2.Visible = False ' oControl2 = oDialogo.getControl("fcLogoOD") oControl2.getModel.Enabled = FALSE ' oControl2 = oDialogo.getControl("fcLogoEst") rutalogo = oControl2.getModel.Text ' oLogo2 = oDialogo.getControl("ImageControl2") 'xray oLogo2.getModel With oLogo2.getModel '.positionX = 30 .ScaleImage = False .ImageURL = ConvertToURL(rutalogo) End With end Sub Sub DosLogo Dim oEti9 As Object Dim oLogo2 As Object Dim oControl2 As Object Dim nAmple as Integer Dim nPosX as Integer ' nAmple = 210 nPosX = 205 oEti9 = oDialogo.getControl("LabelNom") 'oEti9.Width = 160 'oEti9.positionX = 286 With oEti9.getModel .Width = nAmple .positionX = nPosX End With oEti9 = oDialogo.getControl("LabelCarrec") With oEti9.getModel .Width = nAmple .positionX = nPosX End With oEti9 = oDialogo.getControl("LabelDepart") With oEti9.getModel .Width = nAmple .positionX = nPosX End With oEti9 = oDialogo.getControl("LabelDireccio") With oEti9.getModel .Width = nAmple .positionX = nPosX End With oEti9 = oDialogo.getControl("LabelTel") With oEti9.getModel .Width = nAmple .positionX = nPosX End With oEti9 = oDialogo.getControl("LabelCorreu") With oEti9.getModel .Width = nAmple .positionX = nPosX End With oLogo2 = oDialogo.getControl("ImageControl3") oLogo2.Visible = True ' oControl2 = oDialogo.getControl("fcLogoOD") rutalogoOD = oControl2.getModel.Text ' With oLogo2.getModel '.positionX = 30 .ScaleImage = False .ImageURL = ConvertToURL(rutalogoOD) End With End Sub Sub CreaFirmaHtml Dim NumArchivo As Integer Dim NombreArchivo As String Dim LineaActual As String Dim Archivo As String Dim Msg As String Dim nLinea Dim oCheckB as object if not FileExists(rutalogo) or (GetAttr(rutalogo) and 16)=16 then MsgBox "Elija un logo de Conselleria para poder continuar.", MB_ICONINFORMATION, "Info" exit sub end if if cTextNom ="" then MsgBox "Introduzca su nombre para poder continuar.", MB_ICONINFORMATION, "Info" exit sub endif ' oCheckB = oDialogo.getControl("CheckBox1") ' ' Define el nombre del archivo NombreArchivo = ConvertToUrl(rutafirma) & "/firma.html" 'Copia el texto en portapapeles. BIT_SetClipBoard(ConvertFromUrl(NombreArchivo)) ' Establece el manejador de archivo libre. NumArchivo = FreeFile ' Abre el archivo Open NombreArchivo For Output As #NumArchivo Print #NumArchivo, "<!DOCTYPE HTML PUBLIC '-//W3C//DTD HTML 4.01 Transitional//EN'>" Print #NumArchivo, "<html>" Print #NumArchivo, "<head>" Select Case GetGUIType() ' windows Case 1 Print #NumArchivo, "<meta http-equiv='Content-Type' content='text/html; charset=windows-1252'>" ' unix Case 4 Print #NumArchivo, "<meta http-equiv='Content-Type' content='text/html; charset=utf-8'>" Case Else msgbox("Sistema operatiu no suportat, ho sentim :(") exit sub End Select Print #NumArchivo, "<title></title>" Print #NumArchivo,"</head>" Print #NumArchivo,"<body style='' lang='ES'>" Print #NumArchivo,"<div class='Section1'>" Print #NumArchivo,"<div class='MsoNormal' style='text-align: center;' align='center'>" Print #NumArchivo,"<hr align='center' size='2' width='100%' style='height:2px; border:none; color:#B50B35; background-color:#B50B35;'>" Print #NumArchivo,"</div>" if oCheckB.getModel.State = 1 then Print #NumArchivo,"<table class='MsoNormalTable' style='width: 958px;' border='0' cellpadding='0'>" else Print #NumArchivo,"<table class='MsoNormalTable' style='width: 729px;' border='0' cellpadding='0'>" end if Print #NumArchivo,"<tbody>" Print #NumArchivo,"<tr>" if oCheckB.getModel.State = 1 then Print #NumArchivo,"<td style='width: 458px;'>" Print #NumArchivo,"<img alt='Generalitat Valenciana' src='" & ConvertToUrl(rutalogo) &"'>" Print #NumArchivo,"<img alt='Organismo Dependiente' src='" & ConvertToUrl(rutalogoOD) & "'>" Print #NumArchivo,"</td>" else Print #NumArchivo,"<td style='width: 229px;'>" Print #NumArchivo,"<img alt='Generalitat Valenciana' src='" & ConvertToUrl(rutalogo) &"'>" Print #NumArchivo,"</td>" end if Print #NumArchivo,"<td>" Print #NumArchivo,"<p style='font-family: Arial; width: 500px;' class='MsoNormal'><span style='font-size: 12pt;'><b>" & cTextNom & "</b></span><br>" Print #NumArchivo,"<span style='font-size: 10pt;'>" & cTextCarrec & "<br>" Print #NumArchivo, cTextDepart & "<br>" Print #NumArchivo, cTextDireccio & "<br>" Print #NumArchivo, cTextTel & "<br>" Print #NumArchivo, cTextCorreu Print #NumArchivo,"</span></p>" Print #NumArchivo,"</td>" Print #NumArchivo,"</tr>" Print #NumArchivo,"</tbody>" Print #NumArchivo,"</table>" ' Print #NumArchivo,"<p class="MsoNormal"><o:p>&nbsp;</o:p></p>" Print #NumArchivo,"</div>" Print #NumArchivo,"</body>" Print #NumArchivo,"</html>" MsgBox "Archivo " & ConvertFromUrl(NombreArchivo) & chr(13) &_ "creado y copiada la ruta." & chr(13) & chr(13) &_ "Ahora ya puede añadir la firma a Thunderbird" , 48, "Firma" ' Cierra el archivo Close #NumArchivo ' ' Guarda les dades GuardarVariables End Sub Sub Ayuda() Dim cTexto as String cTexto = "Firma para Thunderbird v" &cVersion & chr(13) & chr(13) & _ "Utilizamos los mismos logos del membrete." & chr(13) & chr(13) & _ "Logo Conselleria: Elegimos el logo de entre todos los .png que existan." & chr(13)& chr(13) & _ "Logo organismo dependiente: consiste en introducir en nuestra firma un " & chr(13) & _ " segundo logo de la marca dependiente." & chr(13) & chr(13) & _ "GENERAR: crea el archivo " & rutafirma & getPathSeparator() & "firma.html" & chr(13) & _ " y copia está ruta al portapales. De está forma podremos pegarla" & chr(13) & _ " (CTRL+V) en el campo de Firma de nuestro cliente de correo." & chr(13) & chr(13) & _ " Ejemplo de configuración para Thunderbird: " & chr(13) & _ " Herramientas / Configuración de las cuentas / [nuestra cuenta]" & chr(13) & _ " Marcamos Adjuntar la firma en un archivo y en el cuadro de texto" & chr(13) & _ " pulsamos CTRL+V" & chr(13) & _ " " msgbox(cTexto,64, "Ayuda") end sub Sub StopMacro() oDialogo.EndExecute End Sub Sub fActNom Dim oControl as Object oControl=oDialogo.getControl("TextNom") cTextNom = oControl.Text oControl =oDialogo.getControl("LabelNom") 'Cambiamos el texto que ve el usuario with oControl.getModel .Label = cTextNom End with end Sub Sub fActCarrec Dim oControl as Object oControl=oDialogo.getControl("TextCarrec") cTextCarrec = oControl.Text oControl =oDialogo.getControl("LabelCarrec") 'Cambiamos el texto que ve el usuario with oControl.getModel .Label = cTextCarrec End with end Sub Sub fActDepart Dim oControl as Object oControl=oDialogo.getControl("TextDepart") cTextDepart = oControl.Text oControl =oDialogo.getControl("LabelDepart") 'Cambiamos el texto que ve el usuario with oControl.getModel .Label = cTextDepart End with end Sub Sub fActDireccio Dim oControl as Object oControl=oDialogo.getControl("TextDireccio") cTextDireccio = oControl.Text oControl =oDialogo.getControl("LabelDireccio") 'Cambiamos el texto que ve el usuario with oControl.getModel .Label = cTextDireccio End with end Sub Sub fActTel Dim oControl as Object oControl=oDialogo.getControl("TextTel") cTextTel = oControl.Text oControl =oDialogo.getControl("LabelTel") 'Cambiamos el texto que ve el usuario with oControl.getModel .Label = cTextTel End with end Sub Sub fActCorreu Dim oControl as Object oControl=oDialogo.getControl("TextCorreu") cTextCorreu = oControl.Text oControl =oDialogo.getControl("LabelCorreu") 'Cambiamos el texto que ve el usuario with oControl.getModel .Label = cTextCorreu End with end sub '-------------------------------------------------------------------------------------------- Sub BIT_SetClipBoard( sText As String ) ' Inserta sText en el portapapeles. SOLO TEXTO ' Insert sText into clipboard. ONLY TEXT Dim oClip As Object, oTR As Object ' crea una instancia de SystemClipboard oClip = CreateUNOService( "com.sun.star.datatransfer.clipboard.SystemClipboard") oTR = CreateUNOListener("BIT_Tr_", "com.sun.star.datatransfer.XTransferable") ' insertar en el portapapeles (clipboard) oClip.setContents(oTR,Null) BIT_sTxtClipBoardString = sText ' oClip.flushClipboard() ' no funciona/ no work End Sub '-------------------------------------------------------------------------------------------- '================================================================================================= ' Estas funciones son necesarias para que se pueda pegar en el portapapeles ' These functions are necessary for paste in the clipboard Function BIT_Tr_getTransferData( aFlavor As com.sun.star.datatransfer.DataFlavor) If (aFlavor.MimeType = "text/plain;charset=utf-16") Then BIT_Tr_getTransferData() = BIT_sTxtClipBoardString End If End Function '------------------------------------------------------------------------------- Function BIT_Tr_getTransferDataFlavors() Dim aFlavor As New com.sun.star.datatransfer.DataFlavor aFlavor.MimeType = "text/plain;charset=utf-16" aFlavor.HumanPresentableName = "Unicode-Text" BIT_Tr_getTransferDataFlavors() = array(aFlavor) End Function '------------------------------------------------------------------------------- Function BIT_Tr_isDataFlavorSupported( aFlavor As com.sun.star.datatransfer.DataFlavor) As Boolean If aFlavor.MimeType = "text/plain;charset=utf-16" Then BIT_Tr_isDataFlavorSupported = True Else BIT_Tr_isDataFlavorSupported = False End If End Function '-------------------------------------------------------------------- ' Fin de las funciones necesarias para pegar en el portapapeles '-------------------------------------------------------------------- '=================================================================================================