Re: Como escribir información dentro del exe?
Publicado: 16 Ago 2010, 21:07
Bueno, ya lo he arreglado. Una pequeña condición en el código vbs de que si no hay ningún dato no añada nada, deje el archivo exe original y solucionado
.
Aquí dejo el código vbs indentado. Lo he añadido en un archivo de texto en el rar del post anterior.
Piensa que en el código hay algunas variables que paso desde AutoIt y estas partes no funcionarían en un archivo .vbs . Podría obtener esta información perfectamente en vbs, pero prefiero pasarselas por AutoIt.
Saludos.

Aquí dejo el código vbs indentado. Lo he añadido en un archivo de texto en el rar del post anterior.
Código: Seleccionar todo
'función que te indica si existe un proceso en ejecución. Utilizo el objeto WScript.Shell. Tambien utilizo información de Windows.
'Si el proceso existe da true, y si no da false. Encontrada en: http://www.davidsuarez.es/2008/09/saber-si-un-proceso-se-esta-ejecutando-visual-basic-script-vbs/
Function ExisteProceso(NombreProceso)
Set WshShell = WScript.CreateObject ("WScript.Shell")
Set colProcessList = GetObject("Winmgmts:").ExecQuery ("Select * from Win32_Process")
For Each objProcess in colProcessList
If objProcess.name = NombreProceso then
ExisteProceso = True
Else
ExisteProceso = False
End if
Next
Set WshShell = Nothing
Set colProcessList = Nothing
End Function
'Esta función transforma los datos string a binario para luego poder insertarlos directamente en el exe.
'Utilizo el objeto ADODB.Stream con todas sus posibilidades para trabajar con ficheros binarios y de texto.
'Stream_StringToBinary Function
'2003 Antonin Foller, http://www.motobit.com
'Modificada por chefito
Function Stream_StringToBinary(Text)
Dim BinaryStreamLocal, DatosResult
Set BinaryStreamLocal = CreateObject("ADODB.Stream")
BinaryStreamLocal.Type = adTypeText
BinaryStreamLocal.CharSet = "iso-8859-1"
BinaryStreamLocal.Open
BinaryStreamLocal.WriteText Text
BinaryStreamLocal.Position = 0
BinaryStreamLocal.Type = adTypeBinary
BinaryStreamLocal.Position = 0
DatosResult=BinaryStreamLocal.Read
BinaryStreamLocal.close
Stream_StringToBinary = DatosResult
End Function
Const adTypeText = 2
Const adTypeBinary = 1
Const fichero = "' & @ScriptFullPath & '"
Dim BinaryStreamFile, BinaryStreamDato, BinaryStreamAux, TrozoFile, TrozoDato, ContBucle, ContinuarScript, Datos
ContBucle=0
ContinuarScript=True
Datos="' & $txt & '"'
'bucle. Si existe el proceso de nuestro exe no sale del bucle. Tiene un contador para parar el bucle si al cierto tiempo sigue detectando el proceso.
'$Scriptvbs &= 'Set WshShell = WScript.CreateObject("WScript.Shell")' & @CR
Do While ExisteProceso("' & @ScriptName & '")
WScript.Sleep 50
'$Scriptvbs &= 'WshShell.Sleep=50
ContBucle=ContBucle+1
If ContBucle=60 Then 'cada 20 es un segundo de espera antes de dar el error y salir del script
ContinuarScript=False
MsgBox "No se han podido guardar los datos",16,"Error al grabar los datos"
Exit Do
'$Scriptvbs &= 'WScript.Quit
End If
Loop
'si se ha cerrado el proceso bien y ha salido del bucle, entra en esta condición que contiene todo el código de inserción de los datos al exe.
If ContinuarScript Then
Set BinaryStreamAux = CreateObject("ADODB.Stream")
BinaryStreamAux.Type = adTypeBinary
BinaryStreamAux.Open
Set BinaryStreamFile = CreateObject("ADODB.Stream")
BinaryStreamFile.Type = adTypeBinary
BinaryStreamFile.Open
BinaryStreamFile.LoadFromFile Fichero
TrozoFile=BinaryStreamFile.Read(' & $SizeExe & ')
binarystreamFile.position=0
binarystreamAux.write TrozoFile
If Datos<>"" Then
TrozoDato=Stream_StringToBinary(Datos)
Set BinaryStreamDato = CreateObject("ADODB.Stream")
BinaryStreamDato.Type = adTypeBinary
BinaryStreamDato.Open
binarystreamDato.write TrozoDato
binarystreamDato.position=0
binarystreamDato.copyto binarystreamAux
BinaryStreamDato.close
End If
binarystreamAux.savetofile fichero,2
End If
BinaryStreamFile.close
BinaryStreamAux.close
'código para borrar el propio fichero vbs. Utilizo el objeto Scripting.FileSystemObject.
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
fso.DeleteFile "' & @TempDir & "\Aplicacion.vbs" & '",True
Set fso=Nothing
Saludos.