I tried With below code
Dim pthName As String
Dim Parms As String
Dim RpNo As Integer
Dim glngbr As Long
Dim PrtVw As String
pthName = "D:\Sample.exe"
RpNo = 1
PrtVw = "V"
glngbr = 84003
Shell pthName & Parms
I am getting error "Run time error 53 ".
i tried without parameter its working
Shell pthName
You can use like this,
Shell "D:\Sample.exe" & " " & Param_1, Param_2
Try this:
Shell "D:\Sample.exe" & " " & RpNo & " " & PrtVw & " " & glngbr
Use the api shellexecute http://support.microsoft.com/kb/238245
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
ByVal hwnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
Private Const SW_HIDE As Long = 0
Private Const SW_SHOWNORMAL As Long = 1
Private Const SW_SHOWMAXIMIZED As Long = 3
Private Const SW_SHOWMINIMIZED As Long = 2
private Sub exec_program()
ShellExecute App.hInstance, "Open", "D:\Sample.exe", "Parms", "C:\", SW_SHOWNORMAL
End Sub
You don't need to use the Shell command, or ShellExecute either for that matter. There's a simpler solution: the global VBA.Command object contains whatever string you added when you called your exe file. For example, if you enter myproject.exe hello world on the command line, VBA.Command will contain the string hello world.
If you want multiple command line arguments, you can just put them all on the command line separated by a known delimiter such as /. Then you can use the Split function to break them up.
Read This. It will tell you all about it, including how to use it in the IDE without having to test against a compiled version.
Related
i am using this .Cls file and a command using 7zip to extract specific file from a zip.
my single file gets extracted how ever i need to add if statement to se if my file was found so that i can exit sub it can this piece of code be modifed to add own code
DOSOutputs.cls
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
'Now We can ... must close the hWritePipe
ret = CloseHandle(hWritePipe)
mOutputs = ""
'Read the ReadPipe handle
Do
ret = ReadFile(hReadPipe, strBuff, 256, lngBytesread, 0&)
mOutputs = mOutputs & Left(strBuff, lngBytesread)
'Send data to the object via ReceiveOutputs event
RaiseEvent ReceiveOutputs(Left(strBuff, lngBytesread))
'Pause 0.02
FastDoEvents
Loop While ret <> 0
'Close the opened handles
ret = CloseHandle(proc.hProcess)
ret = CloseHandle(proc.hThread)
ret = CloseHandle(hReadPipe)
'Return the Outputs property with the entire DOS output
ExecuteCommand = mOutputs
End Function
Public Sub FastDoEvents()
Dim uMsg As MsgType
'
Do While PeekMessage(uMsg, 0&, 0&, 0&, PM_REMOVE) ' Reads and deletes message from queue.
TranslateMessage uMsg ' Translates virtual-key messages into character messages.
DispatchMessage uMsg ' Dispatches a message to a window procedure.
Loop
End Sub
form1
Private WithEvents objDOS As DOSOutputs
Private Sub Form_Load()
Set objDOS = New DOSOutputs
End Sub
button command
Private Sub Command22_Click()
On Error Resume Next
On Error GoTo errore
objDOS.CommandLine = text6.text
objDOS.ExecuteCommand
'If objDOS.Outputs = "41_gfx7.rom " Then
'Text1.Text = Text1.Text & objDOS.Outputs & vbNewLine
'End If
Exit Sub
errore:
MsgBox (Err.Description & " - " & Err.Source & " - " & CStr(Err.Number))
End Sub
text6.text has
"C:\Program Files (x86)\7-Zip\7z" x "C:\Users\sarah\Downloads\MAME\MAME_2010_full_nonmerged_romsets\roms\*.zip" -o"C:\Users\sarah\Desktop\rom test\New folder (2)\" *41_gfx7.rom -y
so now am trying to get the status from output using if statement to se if 41_gfx7.rom was found so that i can exit the scan or sub as there is no need to scan further.
or maybe if you can help add better one it will be great,once the string is found exit sub it
Private Sub Command1_Click()
Dim objShell As New WshShell
Dim objExecObject As WshExec
Dim strText As String
Set objExecObject = objShell.Exec(Text6.Text)
Do While Not objExecObject.StdOut.AtEndOfStream
strText = objExecObject.StdOut.ReadLine()
If InStr(strText, "Reply") > 0 Then
Debug.Print "Reply received: " & strText
Exit Do
End If
Loop
End Sub
text6 is my command
ok update
"C:\Program Files (x86)\7-Zip\7z" x "C:\Users\sarah\Downloads\MAME\MAME_2010_full_nonmerged_romsets\roms\*.zip" -o"C:\Users\sarah\Desktop\rom test\New folder (2)\" *41_gfx7.rom -y
i need to add list to this command according to https://sevenzip.osdn.jp/chm/cmdline/commands/list.htm so that file names gets displayed in output data
The following Microsoft article describes two methods that read the output of a command: WSH: Running Programs
The simplest uses the StdOut property of the WshExec object:
Set objShell = WScript.CreateObject("WScript.Shell")
Set objExecObject = objShell.Exec("cmd /c ping -n 3 -w 1000 157.59.0.1")
Do While Not objExecObject.StdOut.AtEndOfStream
strText = objExecObject.StdOut.ReadLine()
If Instr(strText, "Reply") > 0 Then
Wscript.Echo "Reply received."
Exit Do
End If
Loop
You can replace the ping command here with your 7z command and read StdOut to see what your command returned.
Since you are doing this in VB6, you can add a reference (Projects menu > References) to Windows Script Host Object Model library and instantiate the objects with the proper types directly:
Dim objShell As New WshShell
Dim objExecObject As WshExec
Dim strText As String
Set objExecObject = objShell.Exec("cmd /c ping -n 3 -w 1000 127.0.0.1")
Do While Not objExecObject.StdOut.AtEndOfStream
strText = objExecObject.StdOut.ReadLine()
If InStr(strText, "Reply") > 0 Then
Debug.Print "Reply received: " & strText
Exit Do
End If
Loop
With this approach you don't need the DOSCommand.cls, you can simply use the WshShell object for all your operations.
Your Command22_Click would look like this:
Private Sub Command22_Click()
On Error GoTo errore
Dim objShell As New WshShell
Dim objExecObject As WshExec
Dim strText As String
Set objExecObject = objShell.Exec(text6.Text)
Do While Not objExecObject.StdOut.AtEndOfStream
strText = objExecObject.StdOut.ReadLine()
' Parse the text your 7z command returned here
If InStr(strText, "41_gfx7.rom") > 0 Then
Text1.Text = Text1.Text & strText & vbCrLf
Exit Do
End If
Loop
Exit Sub
errore:
MsgBox (Err.Description & " - " & Err.Source & " - " & CStr(Err.Number))
End Sub
Option Explicit
Public Sub save_url_contents_as_text()
Dim MyUrl As String
Dim MyFile As Object 'store the text file here
Dim tempstring As String
MyUrl = "www.AnythingIWantToPutHere"
'I want your help here. Something Like a function
tempstring = geturltext(MyUrl)
'I want to save the URL text contents here
MyFile = tempstring
End Sub
Taken directly from here. Change the URL and the filename as desired. This call writes the contents of the URL to a disk file.
This example shows how to use the URLDownloadToFile API function to download a file from a URL into a file in Visual Basic 6.
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
Private Sub Form_Load()
' Download the file.
URLDownloadToFile 0, _
"http://www.vb-helper.com/vbhelper_425_64.gif", _
"C:\vbhelper_425_64.gif", 0, 0
End Sub
I'm currently working on a program that takes a list of computernames, runs a series of command prompt queries on the computer in question, and then exports the information out to an excel file. So, for example, my program runs this command through CMD:
wmic /node:COMPUTERNAME /user:USER /password:PASSWORD cpu get name
and this returns the given computers cpu name/speed, etc. The issue that I'm running into is that I can export it to a new text file, which then pulls in the headings, so instead of just returning "Intel Core 2 Duo 2.66GHz", it returns this.
Name
Intel Core 2 Duo 2.66 GHz
However, I would RATHER export this out to excel, not a text file. But when I do it for more than one computer, it exports in everything as one cell, instead of parsing the data out.
So my question is: using command prompt, is there anyway to send out or parse out data into an excel file, and is there a way to do so that pulls JUST certain information that you specify?
youc can use this VBA code to run in excel cells your CLI command and return the result as value of each cells.
Function CMD(commande As String)
CMD = GetCommandOutput(commande)
End Function
in other module add this
'Attribute VB_Name = "CmdOutput"
Option Explicit
''''''''''''''''''''''''''''''''''''''''
' Joacim Andersson, Brixoft Software
' http://www.brixoft.net
''''''''''''''''''''''''''''''''''''''''
' STARTUPINFO flags
Private Const STARTF_USESHOWWINDOW = &H1
Private Const STARTF_USESTDHANDLES = &H100
' ShowWindow flags
Private Const SW_HIDE = 0
' DuplicateHandle flags
Private Const DUPLICATE_CLOSE_SOURCE = &H1
Private Const DUPLICATE_SAME_ACCESS = &H2
' Error codes
Private Const ERROR_BROKEN_PIPE = 109
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Private Type STARTUPINFO
cb As Long
lpReserved As String
lpDesktop As String
lpTitle As String
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 ReadFile _
Lib "kernel32" ( _
ByVal hFile As Long, _
lpBuffer As Any, _
ByVal nNumberOfBytesToRead As Long, _
lpNumberOfBytesRead As Long, _
lpOverlapped As Any) As Long
Private Declare Function CreateProcess _
Lib "kernel32" Alias "CreateProcessA" ( _
ByVal lpApplicationName As String, _
ByVal lpCommandLine As String, _
lpProcessAttributes As Any, _
lpThreadAttributes As Any, _
ByVal bInheritHandles As Long, _
ByVal dwCreationFlags As Long, _
lpEnvironment As Any, _
ByVal lpCurrentDriectory As String, _
lpStartupInfo As STARTUPINFO, _
lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function GetCurrentProcess _
Lib "kernel32" () As Long
Private Declare Function DuplicateHandle _
Lib "kernel32" ( _
ByVal hSourceProcessHandle As Long, _
ByVal hSourceHandle As Long, _
ByVal hTargetProcessHandle As Long, _
lpTargetHandle As Long, _
ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, _
ByVal dwOptions As Long) As Long
Private Declare Function CloseHandle _
Lib "kernel32" ( _
ByVal hObject As Long) As Long
Private Declare Function OemToCharBuff _
Lib "user32" Alias "OemToCharBuffA" ( _
lpszSrc As Any, _
ByVal lpszDst As String, _
ByVal cchDstLength As Long) As Long
' Function GetCommandOutput
'
' sCommandLine: [in] Command line to launch
' blnStdOut [in,opt] True (defualt) to capture output to STDOUT
' blnStdErr [in,opt] True to capture output to STDERR. False is default.
' blnOEMConvert: [in,opt] True (default) to convert DOS characters to Windows, False to skip conversion
'
' Returns: String with STDOUT and/or STDERR output
'
Public Function GetCommandOutput(sCommandLine As String, _
Optional blnStdOut As Boolean = True, _
Optional blnStdErr As Boolean = False, _
Optional blnOEMConvert As Boolean = True _
) As String
Dim hPipeRead As Long, hPipeWrite1 As Long, hPipeWrite2 As Long
Dim hCurProcess As Long
Dim sa As SECURITY_ATTRIBUTES
Dim si As STARTUPINFO
Dim pi As PROCESS_INFORMATION
Dim baOutput() As Byte
Dim sNewOutput As String
Dim lBytesRead As Long
Dim fTwoHandles As Boolean
Dim lRet As Long
Dim endTime As Date
Const BUFSIZE = 1024 ' pipe buffer size
endTime = Now + TimeValue("00:00:05")
' At least one of them should be True, otherwise there's no point in calling the function
If (Not blnStdOut) And (Not blnStdErr) Then
Err.Raise 5 ' Invalid Procedure call or Argument
End If
' If both are true, we need two write handles. If not, one is enough.
fTwoHandles = blnStdOut And blnStdErr
ReDim baOutput(BUFSIZE - 1) As Byte
With sa
.nLength = Len(sa)
.bInheritHandle = 1 ' get inheritable pipe handles
End With
If CreatePipe(hPipeRead, hPipeWrite1, sa, BUFSIZE) = 0 Then
Exit Function
End If
hCurProcess = GetCurrentProcess()
' Replace our inheritable read handle with an non-inheritable. Not that it
' seems to be necessary in this case, but the docs say we should.
Call DuplicateHandle(hCurProcess, hPipeRead, hCurProcess, hPipeRead, 0&, _
0&, DUPLICATE_SAME_ACCESS Or DUPLICATE_CLOSE_SOURCE)
' If both STDOUT and STDERR should be redirected, get an extra handle.
If fTwoHandles Then
Call DuplicateHandle(hCurProcess, hPipeWrite1, hCurProcess, hPipeWrite2, 0&, _
1&, DUPLICATE_SAME_ACCESS)
End If
With si
.cb = Len(si)
.dwFlags = STARTF_USESHOWWINDOW Or STARTF_USESTDHANDLES
.wShowWindow = SW_HIDE ' hide the window
If fTwoHandles Then
.hStdOutput = hPipeWrite1
.hStdError = hPipeWrite2
ElseIf blnStdOut Then
.hStdOutput = hPipeWrite1
Else
.hStdError = hPipeWrite1
End If
End With
If CreateProcess(vbNullString, sCommandLine, ByVal 0&, ByVal 0&, 1, 0&, _
ByVal 0&, vbNullString, si, pi) Then
' Close thread handle - we don't need it
Call CloseHandle(pi.hThread)
' Also close our handle(s) to the write end of the pipe. This is important, since
' ReadFile will *not* return until all write handles are closed or the buffer is full.
Call CloseHandle(hPipeWrite1)
hPipeWrite1 = 0
If hPipeWrite2 Then
Call CloseHandle(hPipeWrite2)
hPipeWrite2 = 0
End If
Do
' Add a DoEvents to allow more data to be written to the buffer for each call.
' This results in fewer, larger chunks to be read.
'DoEvents
If ReadFile(hPipeRead, baOutput(0), BUFSIZE, lBytesRead, ByVal 0&) = 0 Then
Exit Do
End If
If Now > endTime Then
GetCommandOutput = GetCommandOutput & "CMD(""TimeOut"")"
Exit Do
End If
If blnOEMConvert Then
' convert from "DOS" to "Windows" characters
sNewOutput = String$(lBytesRead, 0)
Call OemToCharBuff(baOutput(0), sNewOutput, lBytesRead)
Else
' perform no conversion (except to Unicode)
sNewOutput = Left$(StrConv(baOutput(), vbUnicode), lBytesRead)
End If
GetCommandOutput = GetCommandOutput & sNewOutput
' If you are executing an application that outputs data during a long time,
' and don't want to lock up your application, it might be a better idea to
' wrap this code in a class module in an ActiveX EXE and execute it asynchronously.
' Then you can raise an event here each time more data is available.
'RaiseEvent OutputAvailabele(sNewOutput)
Loop
' When the process terminates successfully, Err.LastDllError will be
' ERROR_BROKEN_PIPE (109). Other values indicates an error.
Call CloseHandle(pi.hProcess)
Else
GetCommandOutput = "Failed to create process, check the path of the command line."
End If
' clean up
Call CloseHandle(hPipeRead)
If hPipeWrite1 Then
Call CloseHandle(hPipeWrite1)
End If
If hPipeWrite2 Then
Call CloseHandle(hPipeWrite2)
End If
End Function
wmic can create CSV output, which is a text format that Excel recognizes:
wmic /node:HOST /user:USER /password:PASS /output:C:\path\to\output.csv cpu get name /format:CSV
You need administrative privileges for this, though, otherwise you'll get an error like this:
Invalid XSL format (or) file name.
I'd like to invoke a script on my linux server using VBA in Excel. To do this, I'm using a local copy of Putty that's in the path.
I've successfully written a single command to create a putty session and log in to the server, I'm just unsure how to pass another command after this has been opened in the shell.
Any Ideas?
The below subroutine works, but causes a problem when the second command is attempted.
Cheers
Sub test()
Dim putty As String
Dim strCommand As String
Dim strCommand1 As String
Dim User As String
Dim Pass As String
Dim Host As String
Dim File As String
Dim RemotePath As String
putty = """" & Range("E3").Text & "\Putty.exe"""
User = Range("E8").Text
Pass = Range("E9").Text
Host = Range("E7").Text
'File = """" & Range("E11").Text & """"
RemotePath = Range("E10").Text
strCommand = putty & " -l " & User & " -pw " & Pass & _
" " & File & " " & Host & ":" & RemotePath
'MsgBox strCommand
Shell strCommand, 1 ' vbNormalFocus '
Module2.WaitFor (5)
Shell "ls -l > shell.log", 1
End Sub
use other tool to execute shell command plink
execute this command by this code:
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds 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 CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Sub ShellAndWait(ByVal program_name As String, _
ByVal window_style As VbAppWinStyle)
Dim process_id As Long
Dim process_handle As Long
' Start the program.
On Error GoTo ShellError
process_id = Shell(program_name, window_style)
On Error GoTo 0
DoEvents
' Wait for the program to finish.
' Get the process handle.
process_handle = OpenProcess(SYNCHRONIZE, 0, process_id)
If process_handle <> 0 Then
WaitForSingleObject process_handle, INFINITE
CloseHandle process_handle
End If
Exit Sub
ShellError:
MsgBox Err.Description, vbOKOnly Or vbExclamation, "Error"
End Sub
ShellAndWait "plink -pw password -noagent user#server.com ""rm -f /tmp/file.txt ; gunzip /tmp/file.txt.gz""", vbMaximizedFocus
how can i get the remote computer name based on a given IP Address in vb6? Is there any way that i can list out a list of computers linked to current computer?
If reverse DNS lookup does what you want this might help. This example simplifies the processing of the DNS results, but should get you started and may be enough:
Option Explicit
Private Const DNS_TYPE_PTR = &HC
Private Const DNS_QUERY_STANDARD = &H0
Private Const DnsFreeRecordListDeep = 1&
Private Enum DNS_STATUS
ERROR_BAD_IP_FORMAT = -3&
ERROR_NO_PTR_RETURNED = -2&
ERROR_NO_RR_RETURNED = -1&
DNS_STATUS_SUCCESS = 0&
End Enum
Private Type VBDnsRecord
pNext As Long
pName As Long
wType As Integer
wDataLength As Integer
Flags As Long
dwTTL As Long
dwReserved As Long
prt As Long
others(9) As Long
End Type
Private Declare Function DnsQuery Lib "Dnsapi" Alias "DnsQuery_A" ( _
ByVal Name As String, _
ByVal wType As Integer, _
ByVal Options As Long, _
ByRef aipServers As Any, _
ByRef ppQueryResultsSet As Long, _
ByVal pReserved As Long) As Long
Private Declare Function DnsRecordListFree Lib "Dnsapi" ( _
ByVal pDnsRecord As Long, _
ByVal DnsFreeRecordListDeep As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
ByRef pTo As Any, _
ByRef uFrom As Any, _
ByVal lSize As Long)
Private Declare Function StrCopyA Lib "kernel32" Alias "lstrcpyA" ( _
ByVal retval As String, _
ByVal PTR As Long) As Long
Private Declare Function StrLenA Lib "kernel32" Alias "lstrlenA" ( _
ByVal PTR As Long) As Long
Public Function IP2HostName(ByVal IP As String, ByRef HostName As String) As Long
Dim Octets() As String
Dim OctX As Long
Dim NumPart As Long
Dim BadIP As Boolean
Dim lngDNSRec As Long
Dim Record As VBDnsRecord
Dim Length As Long
'Returns DNS_STATUS Enum values, otherwise a DNS system error code.
IP = Trim$(IP)
If Len(IP) = 0 Then IP2HostName = ERROR_BAD_IP_FORMAT: Exit Function
Octets = Split(IP, ".")
If UBound(Octets) <> 3 Then IP2HostName = ERROR_BAD_IP_FORMAT: Exit Function
For OctX = 0 To 3
If IsNumeric(Octets(OctX)) Then
NumPart = CInt(Octets(OctX))
If 0 <= NumPart And NumPart <= 255 Then
Octets(OctX) = CStr(NumPart)
Else
BadIP = True
Exit For
End If
Else
BadIP = True
Exit For
End If
Next
If BadIP Then IP2HostName = ERROR_BAD_IP_FORMAT: Exit Function
IP = Octets(3) & "." & Octets(2) & "." & Octets(1) & "." & Octets(0) & ".IN-ADDR.ARPA"
IP2HostName = DnsQuery(IP, DNS_TYPE_PTR, DNS_QUERY_STANDARD, ByVal 0, lngDNSRec, 0)
If IP2HostName = DNS_STATUS_SUCCESS Then
If lngDNSRec <> 0 Then
CopyMemory Record, ByVal lngDNSRec, LenB(Record)
With Record
If .wType = DNS_TYPE_PTR Then
Length = StrLenA(.prt)
HostName = String$(Length, 0)
StrCopyA HostName, .prt
Else
IP2HostName = ERROR_NO_PTR_RETURNED
End If
End With
DnsRecordListFree lngDNSRec, DnsFreeRecordListDeep
Else
IP2HostName = ERROR_NO_RR_RETURNED
End If
'Else
'Return with DNS error code.
End If
End Function
Note however it does not handle NetBIOS names.
According to this Microsoft support article, the standard GetHostByAddr() functions should do it. Unfortunately, I can't find any examples of how to do a GetHostByAddr call in VB6, but perhaps someone else can help with that part. Alternately, you could run a commandline tool like nslookup:
bensonk#hunter ~/Desktop/cont $ nslookup 64.34.119.12
Server: 208.67.222.222
Address: 208.67.222.222#53
Non-authoritative answer:
12.119.34.64.in-addr.arpa name = stackoverflow.com.
That example was run on a linux machine, but the same command will work fine on windows.
MOST SIMPLE TECHNIQUE EVER
To send computer name ,
Do this:
Create a textbox,
Change its multiline property to true.
After that, in the text property of that textbox, write this:
echo %computername% >> C:\temp.txt
then, using Fileinput, input the textfile and input the textfile C:\temp.txt.
If you want to use this for sending over winsock or LAN, Send the text box text using winsock1.sendata
Done