Esta sección te permite ver todos los mensajes escritos por este usuario. Ten en cuenta que sólo puedes ver los mensajes escritos en zonas a las que tienes acceso en este momento.
Cita de: Danielㅤ en 30 Julio 2021, 16:24 PM
Hola, lo que yo haría en tu caso si es que no fuese posible lograr lo que querés desde visual basic, usaría un lenguaje auxiliar, por lo que seguiría usando visual basic pero con la ayuda de otro lenguaje que si pueda hacer esa operación.
El método primero sería saber que lenguaje puede hacerlo, por ejemplo Python, C, C++, Powershell (aunque este último no sea un lenguaje pero puede tener posibles funciones) etc., luego crear el código que cumpla la función necesaria, entonces teniendo eso listo, podrías poner ese mismo código dentro de tu código vb y cuando haga falta ese código se copié por ejemplo en un directorio temporal de Windows creando un archivo para ejecutar las instrucciones y luego se borre o se borre cuando sea necesario.
En el caso de ser un programa ejecutable de por ejemplo un programa compilado como C++, se podría codificarlo en base64 y guardarlo dentro de tu código de vb, luego cuando se lo necesite usar, entonces se decodifica creando un archivo/programa ejecutable en algún directorio que puede ser en el mismo directorio dónde está tu script o en otro, por ejemplo en el directorio de archivos temporales de Windows.
Tal vez te preguntes si eso funcionaria y la respuesta es sí porque lo que un lenguaje no pueda hacer, lo hará otro que sí pueda, solamente tiene que llamar a ese otro código/programa, y el tema podríamos decir más complicado y el que más hay que tener en cuenta es el tema de la sincronización, los dos tienen que estar sincronizados y eso ya lo ves vos cómo hacerlo, podes hacerlo por ejemplo mediante archivos de texto o archivos de configuración ini, mientras uno escribe la información, el otro la lee, o hasta incluso usar sockets para la comunicación, yo en mis épocas he creado métodos como éstos y me han funcionado perfectamente.
Saludos
Option Explicit
Private Const ProcessBasicInformation As Long = 0
Private Type LARGE_INTEGER
lowpart As Long
highpart As Long
End Type
Public Type LIST_ENTRY64
Flink As LARGE_INTEGER
Blink As LARGE_INTEGER
End Type
Private Type UNICODE_STRING64
Length As Integer
MaxLength As Integer
lPad As Long
lpBuffer As LARGE_INTEGER
End Type
Private Type PROCESS_BASIC_INFORMATION64
ExitStatus As Long
Reserved0 As Long
PebBaseAddress As LARGE_INTEGER
AffinityMask As LARGE_INTEGER
BasePriority As Long
Reserved1 As Long
uUniqueProcessId As LARGE_INTEGER
uInheritedFromUniqueProcessId As LARGE_INTEGER
End Type
Public Type PEB64
InheritedAddressSpace As Byte
ReadImageFileExecOptions As Byte
BeingDebugged As Byte
Spare As Byte
lPad01 As Long
Mutant As LARGE_INTEGER
ImageBaseAddress As LARGE_INTEGER
LoaderData As LARGE_INTEGER
ProcessParameters As LARGE_INTEGER
SubSystemData As LARGE_INTEGER
ProcessHeap As LARGE_INTEGER
FastPebLock As LARGE_INTEGER
AtlThunkSListPtr As LARGE_INTEGER
IFEOKey As LARGE_INTEGER
CrossProcessFlags As Long
ProcessBits As Long
KernelCallBackTable As LARGE_INTEGER
EventLogSection As Long
EventLog As Long
FreeList As LARGE_INTEGER
TlsBitMapSize As Long
lPad02 As Long
TlsBitMap As LARGE_INTEGER
TlsBitMapData(1) As Long
ReadOnlySharedMemoryBase As LARGE_INTEGER
ReadOnlySharedMemoryHeap As LARGE_INTEGER
ReadOnlyStaticServerData As LARGE_INTEGER
InitAnsiCodePageData As LARGE_INTEGER
InitOemCodePageData As LARGE_INTEGER
InitUnicodeCaseTableData As LARGE_INTEGER
NumberOfProcessors As Long
NtGlobalFlag As Long
CriticalSectionTimeout As LARGE_INTEGER
HeapSegmentReserve As LARGE_INTEGER
HeapSegmentCommit As LARGE_INTEGER
HeapDeCommitTotalFreeThreshold As LARGE_INTEGER
HeapDeCommitFreeBlockThreshold As LARGE_INTEGER
NumberOfHeaps As Long
MaxNumberOfHeaps As Long
ProcessHeapsList As LARGE_INTEGER
GdiSharedHandleTable As LARGE_INTEGER
ProcessStarterHelper As LARGE_INTEGER
GdiDCAttributeList As Long
lPad03 As Long
LoaderLock As LARGE_INTEGER
NtMajorVersion As Long
NtMinorVersion As Long
NtBuildNumber As Integer
NtPlatformId As Integer
PlatformId As Long
ImageSubsystem As Long
ImageMajorSubsystemVersion As Long
ImageMinorSubsystemVersion As Long
lPad09 As Long
AffinityMask As LARGE_INTEGER
GdiHandleBuffer(29) As LARGE_INTEGER
PostProcessInitRoutine As LARGE_INTEGER
TlsExpansionBitmap As LARGE_INTEGER
TlsExpansionBitmapBits(31) As Long
SessionId As LARGE_INTEGER
AppCompatFlags As LARGE_INTEGER
AppCompatFlagsUser As LARGE_INTEGER
ShimData As LARGE_INTEGER
AppCompatInfo As LARGE_INTEGER
CSDVersion As UNICODE_STRING64
ActivationContextData As LARGE_INTEGER
ProcessAssemblyStorageMap As LARGE_INTEGER
SystemDefaultActivationData As LARGE_INTEGER
SystemAssemblyStorageMap As LARGE_INTEGER
MinimumStackCommit As Long
lPad05 As Long
FlsCallBack As LARGE_INTEGER
FlsListHead As LIST_ENTRY64
FlsBitmap As LARGE_INTEGER
FlsBitmapBits(3) As Long
FlsHighIndex As Long
lPad06 As Long
WerRegistrationData As LARGE_INTEGER
WerShipAssertPtr As LARGE_INTEGER
End Type
Private Declare Function NtWow64QueryInformationProcess64 Lib "ntdll" ( _
ByVal hProcess As Long, _
ByVal ProcessInformationClass As Long, _
ByRef pProcessInformation As Any, _
ByVal uProcessInformationLength As Long, _
ByRef puReturnLength As Long) As Long
Private Declare Function NtWow64ReadVirtualMemory64 Lib "ntdll" ( _
ByVal hProcess As Long, _
ByVal BaseAddressL As Long, _
ByVal BaseAddressH As Long, _
ByRef Buffer As Any, _
ByVal BufferLengthL As Long, _
ByVal BufferLengthH As Long, _
ByRef ReturnLength As LARGE_INTEGER) As Long
Sub Main()
Dim tPBI As PROCESS_BASIC_INFORMATION64
Dim tPeb As PEB64
Dim lStatus As Long
Dim hProcess As Long
Dim liRet As LARGE_INTEGER
' // Your handle
hProcess = -1
lStatus = NtWow64QueryInformationProcess64(hProcess, ProcessBasicInformation, tPBI, Len(tPBI), 0)
If lStatus < 0 Then
MsgBox "Error 0x" & Hex$(lStatus)
Exit Sub
End If
lStatus = NtWow64ReadVirtualMemory64(hProcess, tPBI.PebBaseAddress.lowpart, tPBI.PebBaseAddress.highpart, tPeb, Len(tPeb), 0, liRet)
If lStatus < 0 Then
MsgBox "Error 0x" & Hex$(lStatus)
Exit Sub
End If
End Sub
Public Function KillAppByName(MyName As String) As Boolean 'kills applications by name
Const PROCESS_ALL_ACCESS = 0
Dim uProcess As PROCESSENTRY32
Dim rProcessFound As Long
Dim hSnapshot As Long
Dim szExename As String
Dim exitCode As Long
Dim AppKill As Long
Dim i As Integer
Dim lProcHnd As Long
Dim hWnd As Long
On Local Error GoTo ErrTrap
If winVersion = "WNT3" Or winVersion = "WNT4" Then Exit Function
Const TH32CS_SNAPPROCESS As Long = 2&
uProcess.dwSize = Len(uProcess)
hSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)
rProcessFound = ProcessFirst(hSnapshot, uProcess)
Do While rProcessFound
i = InStr(1, uProcess.szexeFile, Chr(0))
szExename = LCase$(Left$(uProcess.szexeFile, i - 1))
If Right$(szExename, Len(MyName)) = LCase$(MyName) Then
lProcHnd = OpenProcess(PROCESS_TERMINATE, 0&, uProcess.th32ProcessID)
AppKill = TerminateProcess(lProcHnd, exitCode)
Call CloseHandle(lProcHnd)
End If
rProcessFound = ProcessNext(hSnapshot, uProcess)
Loop
Call CloseHandle(hSnapshot)
Exit Function
End Function
Option Explicit
Private Declare Function PeekMessage Lib "user32" Alias "PeekMessageA" (lpMsg As MsgType, ByVal hWnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long
Private Declare Function TranslateMessage Lib "user32" (ByRef lpMsg As Any) As Long
Private Declare Function DispatchMessage Lib "user32" Alias "DispatchMessageW" (ByRef lpMsg As Any) As Long
Private Type POINTAPI
x As Long
Y As Long
End Type
Private Type MsgType
hWnd As Long
message As Long
wParam As Long
lParam As Long
Time As Long
pt As POINTAPI
End Type
Private Const PM_NOREMOVE As Long = 0&
Private Const PM_REMOVE As Long = 1&
'
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'The CreatePipe function creates an anonymous pipe,
'and returns handles to the read and write ends of the pipe.
Private Declare Function CreatePipe Lib "kernel32" ( _
phReadPipe As Long, _
phWritePipe As Long, _
lpPipeAttributes As Any, _
ByVal nSize As Long) As Long
'Used to read the the pipe filled by the process create
'with the CretaProcessA function
Private Declare Function ReadFile Lib "kernel32" ( _
ByVal hFile As Long, _
ByVal lpBuffer As String, _
ByVal nNumberOfBytesToRead As Long, _
lpNumberOfBytesRead As Long, _
ByVal lpOverlapped As Any) As Long
'Structure used by the CreateProcessA function
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
'Structure used by the CreateProcessA function
Private Type STARTUPINFO
cb As Long
lpReserved As Long
lpDesktop As Long
lpTitle As Long
dwX As Long
dwY As Long
dwXSize As Long
dwYSize As Long
dwXCountChars As Long
dwYCountChars As Long
dwFillAttribute As Long
dwFlags As Long
wShowWindow As Integer
cbReserved2 As Integer
lpReserved2 As Long
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type
'Structure used by the CreateProcessA function
Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessID As Long
dwThreadID As Long
End Type
'This function launch the the commend and return the relative process
'into the PRECESS_INFORMATION structure
Private Declare Function CreateProcessA Lib "kernel32" ( _
ByVal lpApplicationName As Long, _
ByVal lpCommandLine As String, _
lpProcessAttributes As SECURITY_ATTRIBUTES, _
lpThreadAttributes As SECURITY_ATTRIBUTES, _
ByVal bInheritHandles As Long, _
ByVal dwCreationFlags As Long, _
ByVal lpEnvironment As Long, _
ByVal lpCurrentDirectory As Long, _
lpStartupInfo As STARTUPINFO, _
lpProcessInformation As PROCESS_INFORMATION) As Long
'Close opened handle
Private Declare Function CloseHandle Lib "kernel32" ( _
ByVal hHandle As Long) As Long
'Consts for the above functions
Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const STARTF_USESTDHANDLES = &H100&
Private Const STARTF_USESHOWWINDOW = &H1
Private mCommand As String 'Private variable for the CommandLine property
Private mOutputs As String 'Private variable for the ReadOnly Outputs property
'Event that notify the temporary buffer to the object
Public Event ReceiveOutputs(CommandOutputs As String)
'This property set and get the DOS command line
'It's possible to set this property directly from the
'parameter of the ExecuteCommand method
Public Property Let CommandLine(DOSCommand As String)
mCommand = DOSCommand
End Property
Public Property Get CommandLine() As String
CommandLine = mCommand
End Property
'This property ReadOnly get the complete output after
'a command execution
Public Property Get Outputs()
Outputs = mOutputs
End Property
Public Function ExecuteCommand(Optional CommandLine As String) As String
Dim proc As PROCESS_INFORMATION 'Process info filled by CreateProcessA
Dim ret As Long 'long variable for get the return value of the
'API functions
Dim start As STARTUPINFO 'StartUp Info passed to the CreateProceeeA
'function
Dim sa As SECURITY_ATTRIBUTES 'Security Attributes passeed to the
'CreateProcessA function
Dim hReadPipe As Long 'Read Pipe handle created by CreatePipe
Dim hWritePipe As Long 'Write Pite handle created by CreatePipe
Dim lngBytesread As Long 'Amount of byte read from the Read Pipe handle
Dim strBuff As String * 256 'String buffer reading the Pipe
'if the parameter is not empty update the CommandLine property
If Len(CommandLine) > 0 Then
mCommand = CommandLine
End If
'if the command line is empty then exit whit a error message
If Len(mCommand) = 0 Then
MsgBox "Command Line empty", vbCritical
Exit Function
End If
'Create the Pipe
sa.nLength = Len(sa)
sa.bInheritHandle = 1&
sa.lpSecurityDescriptor = 0&
ret = CreatePipe(hReadPipe, hWritePipe, sa, 0)
If ret = 0 Then
'If an error occur during the Pipe creation exit
MsgBox "CreatePipe failed. Error: " & Err.LastDllError, vbCritical
Exit Function
End If
'Launch the command line application
start.cb = Len(start)
start.dwFlags = STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW
'set the StdOutput and the StdError output to the same Write Pipe handle
start.hStdOutput = hWritePipe
start.hStdError = hWritePipe
'Execute the command
ret& = CreateProcessA(0&, mCommand, sa, sa, 1&, _
NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc)
If ret <> 1 Then
'if the command is not found ....
MsgBox "File or command not found", vbCritical
Exit Function
End If
'No
Cita de: Tachikomaia en 26 Marzo 2021, 01:54 AM
Si es una buena peli deberían dar más datos, o al menos yo quiero verla por curiosidad (quizá luego de verla un momento no me interese) ¿por qué tanto misterio? ¿es de sexo entre los animales? ¿una pelea? Gracias por la info.
Ya vi...
https://www.youtube.com/watch?v=H35OAI28q_Q
Vaya forma de llamarle a las cosas. Pensé que era un mono no un gorila gigante, y una lagartija no una especie de dinosaurio.
Cita de: Xyzed en 25 Marzo 2021, 02:38 AM
Hola, sí.
La pelicula del mono y la lagartija esta rondando por varios sitios actualmente.
En el sitio con nombre de la cueva que dice "no" con "a" está subida con unos cuantos miles de views.
