@Steffan-68
I was comparing that one to the one I downloaded...
2021 version:
Code: (Select All)
$If PIPECOM = UNDEFINED Then
$Let PIPECOM = TRUE
Function pipecom& (cmd As String, stdout As String, stderr As String)
stdout = "": stderr = ""
$If WIN Then
Type SECURITY_ATTRIBUTES
As _Unsigned Long nLength
$If 64BIT Then
As String * 4 padding
$End If
As _Offset lpSecurityDescriptor
As Long bInheritHandle
$If 64BIT Then
As String * 4 padding2
$End If
End Type
Type STARTUPINFO
As Long cb
$If 64BIT Then
As String * 4 padding
$End If
As _Offset lpReserved, lpDesktop, lpTitle
As _Unsigned Long dwX, dwY, dwXSize, dwYSize, dwXCountChars, dwYCountChars, dwFillAttribute, dwFlags
As _Unsigned Integer wShowWindow, cbReserved2
$If 64BIT Then
As String * 4 padding2
$End If
As _Offset lpReserved2, hStdInput, hStdOutput, hStdError
End Type
Type PROCESS_INFORMATION
As _Offset hProcess, hThread
As _Unsigned Long dwProcessId
$If 64BIT Then
As String * 4 padding
$End If
End Type
Const STARTF_USESTDHANDLES = &H00000100
Const CREATE_NO_WINDOW = &H8000000
Const INFINITE = 4294967295
Const WAIT_FAILED = &HFFFFFFFF
Declare CustomType Library
Function CreatePipe& (ByVal hReadPipe As _Offset, Byval hWritePipe As _Offset, Byval lpPipeAttributes As _Offset, Byval nSize As _Unsigned Long)
Function CreateProcess& (ByVal lpApplicationName As _Offset, Byval lpCommandLine As _Offset, Byval lpProcessAttributes As _Offset, Byval lpThreadAttributes As _Offset, Byval bInheritHandles As Long, Byval dwCreationFlags As _Unsigned Long, Byval lpEnvironment As _Offset, Byval lpCurrentDirectory As _Offset, Byval lpStartupInfo As _Offset, Byval lpProcessInformation As _Offset)
Function GetExitCodeProcess& (ByVal hProcess As _Offset, Byval lpExitCode As _Offset)
Sub HandleClose Alias "CloseHandle" (ByVal hObject As _Offset)
Function ReadFile& (ByVal hFile As _Offset, Byval lpBuffer As _Offset, Byval nNumberOfBytesToRead As _Unsigned Long, Byval lpNumberOfBytesRead As _Offset, Byval lpOverlapped As _Offset)
Function WaitForSingleObject~& (ByVal hHandle As _Offset, Byval dwMilliseconds As _Unsigned Long)
End Declare
Dim As Long ok: ok = 1
Dim As _Offset hStdOutPipeRead, hStdOutPipeWrite, hStdReadPipeError, hStdOutPipeError
Dim As SECURITY_ATTRIBUTES sa: sa.nLength = Len(sa): sa.lpSecurityDescriptor = 0: sa.bInheritHandle = 1
If CreatePipe(_Offset(hStdOutPipeRead), _Offset(hStdOutPipeWrite), _Offset(sa), 0) = 0 Then
pipecom = -1
Exit Function
End If
If CreatePipe(_Offset(hStdReadPipeError), _Offset(hStdOutPipeError), _Offset(sa), 0) = 0 Then
pipecom = -1
Exit Function
End If
Dim As STARTUPINFO si
si.cb = Len(si)
si.dwFlags = STARTF_USESTDHANDLES
si.hStdError = hStdOutPipeError
si.hStdOutput = hStdOutPipeWrite
si.hStdInput = 0
Dim As PROCESS_INFORMATION procinfo
Dim As _Offset lpApplicationName
Dim As String lpCommandLine: lpCommandLine = "cmd /c " + cmd + Chr$(0)
Dim As _Offset lpProcessAttributes, lpThreadAttributes
Dim As Long bInheritHandles: bInheritHandles = 1
Dim As _Unsigned Long dwCreationFlags: dwCreationFlags = CREATE_NO_WINDOW
Dim As _Offset lpEnvironment, lpCurrentDirectory
ok = CreateProcess(lpApplicationName, _Offset(lpCommandLine), lpProcessAttributes, lpThreadAttributes, bInheritHandles, dwCreationFlags, lpEnvironment, lpCurrentDirectory, _Offset(si), _Offset(procinfo))
If ok = 0 Then
pipecom = -1
Exit Function
End If
HandleClose hStdOutPipeWrite
HandleClose hStdOutPipeError
Dim As String buf: buf = Space$(4096 + 1)
Dim As _Unsigned Long dwRead
While ReadFile(hStdOutPipeRead, _Offset(buf), 4096, _Offset(dwRead), 0) <> 0 And dwRead > 0
buf = Mid$(buf, 1, dwRead)
GoSub RemoveChr13
stdout = stdout + buf
buf = Space$(4096 + 1)
Wend
While ReadFile(hStdReadPipeError, _Offset(buf), 4096, _Offset(dwRead), 0) <> 0 And dwRead > 0
buf = Mid$(buf, 1, dwRead)
GoSub RemoveChr13
stderr = stderr + buf
buf = Space$(4096 + 1)
Wend
Dim As Long exit_code, ex_stat
If WaitForSingleObject(procinfo.hProcess, INFINITE) <> WAIT_FAILED Then
If GetExitCodeProcess(procinfo.hProcess, _Offset(exit_code)) Then
ex_stat = 1
End If
End If
HandleClose hStdOutPipeRead
HandleClose hStdReadPipeError
If ex_stat = 1 Then
pipecom = exit_code
Else
pipecom = -1
End If
Exit Function
RemoveChr13:
Dim As Long j
j = InStr(buf, Chr$(13))
Do While j
buf = Left$(buf, j - 1) + Mid$(buf, j + 1)
j = InStr(buf, Chr$(13))
Loop
Return
$Else
Declare CustomType Library
Function popen%& (cmd As String, readtype As String)
Function feof& (ByVal stream As _Offset)
Function fgets$ (str As String, Byval n As Long, Byval stream As _Offset)
Function pclose& (ByVal stream As _Offset)
End Declare
Declare Library
Function WEXITSTATUS& (ByVal stat_val As Long)
End Declare
Dim As _Offset stream
Dim buffer As String * 4096
If _FileExists("pipestderr") Then
Kill "pipestderr"
End If
stream = popen(cmd + " 2>pipestderr", "r")
If stream Then
While feof(stream) = 0
If fgets(buffer, 4096, stream) <> "" And feof(stream) = 0 Then
stdout = stdout + Mid$(buffer, 1, InStr(buffer, Chr$(0)) - 1)
End If
Wend
Dim As Long status, exit_code
status = pclose(stream)
exit_code = WEXITSTATUS(status)
If _FileExists("pipestderr") Then
Dim As Integer errfile
errfile = FreeFile
Open "pipestderr" For Binary As #errfile
If LOF(errfile) > 0 Then
stderr = Space$(LOF(errfile))
Get #errfile, , stderr
End If
Close #errfile
Kill "pipestderr"
End If
pipecom = exit_code
Else
pipecom = -1
End If
$End If
End Function
Function pipecom_lite$ (cmd As String)
Dim As Long a
Dim As String stdout, stderr
a = pipecom(cmd, stdout, stderr)
If stderr <> "" Then
pipecom_lite = stderr
Else
pipecom_lite = stdout
End If
End Function
$End If
And the one in the thread you mentioned from 2023. Oh, I substituted in Spriggsys while from Steve's post:
Code: (Select All)
Common Shared winver%, utente$
Common Shared ip4$
Dim ver As String
ver = Mid$(pipecom_lite("ver"), 2)
Print pipecom_lite("ver")
Sleep
k$ = ""
For f = 1 To Len(ver)
If InStr("1234567890.", Mid$(ver, f, 1)) <> 0 Then k$ = k$ + Mid$(ver, f, 1)
Next f
If InStr(k$, "6.1.76") > 0 Then
winver = 7
ElseIf InStr(k$, "6.2.") > 0 Or InStr(k$, "6.3.") > 0 Then
winver = 8
ElseIf InStr(k$, "10.") > 0 Then
winver = 10
End If
If winver = 10 Then
For f = InStr(_Dir$(""), "User") To Len(_Dir$(""))
If Mid$(_Dir$(""), f, 1) = "\" Then Exit For
Next f
utente$ = Mid$(_Dir$(""), f + 1, InStr(Mid$(_Dir$(""), f + 1), "\") - 1)
ElseIf winver = 7 Then
For f = InStr(_Dir$(""), "User") To Len(_Dir$(""))
If Mid$(_Dir$(""), f, 1) = "\" Then Exit For
Next f
utente$ = Mid$(_Dir$(""), f + 1, InStr(Mid$(_Dir$(""), f + 1), "\") - 1)
End If
End
'-----------------------------------------------------------------------------------------------------------------------------
'6.0.6000 Windows Vista
'6.0.6001 Windows Vista with Service Pack 1 'or Windows Server 2008
'6.1.7600 Windows 7 'or Windows Server 2008 R2
'6.1.7601 Windows 7 with Service Pack 1 'or Windows Server 2008 R2 with Service Pack 1
'6.2.9200 Windows 8 'or Windows Server 2012
'6.3.9200 Windows 8.1 'or Windows Server 2012 R2
'6.3.9600 Windows 8.1 with Update 1
'10.0.10240 Windows 10 Version 1507
'10.0.10586 Windows 10 Version 1511 (November Update)
'10.0.14393 Windows 10 Version 1607 (Anniversary Update) 'or Windows Server 2016
'10.0.15063 Windows 10 Version 1703 (Creators Update)
'10.0.16299 Windows 10 Version 1709 (Fall Creators Update)
'10.0.17134 Windows 10 Version 1803 (April 2018 Update)
'10.0.17763 Windows 10 Version 1809 (October 2018 Update) 'or Windows Server 2019
'10.0.18362 Windows 10 Version 1903 (May 2019 Update)
'10.0.18363 Windows 10 Version 1909 (November 2019 Update)
'10.0.19041 Windows 10 Version 2004 (May 2020 Update)
'Note that there is normally no need to specify the build numbers (i.e., you may simply use "6.2" for Windows 8).
'-----------------------------------------------------------------------------------------------------------------------------
$If PIPECOM = UNDEFINED Then
$Let PIPECOM = TRUE
Function pipecom& (cmd As String, stdout As String, stderr As String)
stdout = "": stderr = ""
$If WIN Then
Type SECURITY_ATTRIBUTES
As _Unsigned Long nLength
$If 64BIT Then
As String * 4 padding
$End If
As _Offset lpSecurityDescriptor
As Long bInheritHandle
$If 64BIT Then
As String * 4 padding2
$End If
End Type
Type STARTUPINFO
As Long cb
$If 64BIT Then
As String * 4 padding
$End If
As _Offset lpReserved, lpDesktop, lpTitle
As _Unsigned Long dwX, dwY, dwXSize, dwYSize, dwXCountChars, dwYCountChars, dwFillAttribute, dwFlags
As _Unsigned Integer wShowWindow, cbReserved2
$If 64BIT Then
As String * 4 padding2
$End If
As _Offset lpReserved2, hStdInput, hStdOutput, hStdError
End Type
Type PROCESS_INFORMATION
As _Offset hProcess, hThread
As _Unsigned Long dwProcessId
$If 64BIT Then
As String * 4 padding
$End If
End Type
Const STARTF_USESTDHANDLES = &H00000100
Const CREATE_NO_WINDOW = &H8000000
Const INFINITE = 4294967295
Const WAIT_FAILED = &HFFFFFFFF
Declare CustomType Library
Function CreatePipe& (ByVal hReadPipe As _Offset, Byval hWritePipe As _Offset, Byval lpPipeAttributes As _Offset, Byval nSize As _Unsigned Long)
Function CreateProcess& (ByVal lpApplicationName As _Offset, Byval lpCommandLine As _Offset, Byval lpProcessAttributes As _Offset, Byval lpThreadAttributes As _Offset, Byval bInheritHandles As Long, Byval dwCreationFlags As _Unsigned Long, Byval lpEnvironment As _Offset, Byval lpCurrentDirectory As _Offset, Byval lpStartupInfo As _Offset, Byval lpProcessInformation As _Offset)
Function GetExitCodeProcess& (ByVal hProcess As _Offset, Byval lpExitCode As _Offset)
Sub HandleClose Alias "CloseHandle" (ByVal hObject As _Offset)
Function ReadFile& (ByVal hFile As _Offset, Byval lpBuffer As _Offset, Byval nNumberOfBytesToRead As _Unsigned Long, Byval lpNumberOfBytesRead As _Offset, Byval lpOverlapped As _Offset)
Function WaitForSingleObject~& (ByVal hHandle As _Offset, Byval dwMilliseconds As _Unsigned Long)
End Declare
Dim As Long ok: ok = 1
Dim As _Offset hStdOutPipeRead, hStdOutPipeWrite, hStdReadPipeError, hStdOutPipeError
Dim As SECURITY_ATTRIBUTES sa: sa.nLength = Len(sa): sa.lpSecurityDescriptor = 0: sa.bInheritHandle = 1
If CreatePipe(_Offset(hStdOutPipeRead), _Offset(hStdOutPipeWrite), _Offset(sa), 0) = 0 Then
pipecom = -1
Exit Function
End If
If CreatePipe(_Offset(hStdReadPipeError), _Offset(hStdOutPipeError), _Offset(sa), 0) = 0 Then
pipecom = -1
Exit Function
End If
Dim si As STARTUPINFO
si.cb = Len(si)
si.dwFlags = STARTF_USESTDHANDLES
si.hStdError = hStdOutPipeError
si.hStdOutput = hStdOutPipeWrite
si.hStdInput = 0
Dim As PROCESS_INFORMATION procinfo
Dim As _Offset lpApplicationName
Dim As String lpCommandLine: lpCommandLine = "cmd /c " + cmd + Chr$(0)
Dim As _Offset lpProcessAttributes, lpThreadAttributes
Dim As Long bInheritHandles: bInheritHandles = 1
Dim As _Unsigned Long dwCreationFlags: dwCreationFlags = CREATE_NO_WINDOW
Dim As _Offset lpEnvironment, lpCurrentDirectory
ok = CreateProcess(lpApplicationName, _Offset(lpCommandLine), lpProcessAttributes, lpThreadAttributes, bInheritHandles, dwCreationFlags, lpEnvironment, lpCurrentDirectory, _Offset(si), _Offset(procinfo))
If ok = 0 Then
pipecom = -1
Exit Function
End If
HandleClose hStdOutPipeWrite
HandleClose hStdOutPipeError
Dim As String buf: buf = Space$(4096 + 1)
Dim As _Unsigned Long dwRead
While 1
'While ReadFile(hStdOutPipeRead, _Offset(buf), 4096, _Offset(dwRead), 0) <> 0 And dwRead > 0
x = ReadFile(hStdOutPipeRead, _Offset(buf), 4096, _Offset(dwRead), 0)
If x <> 0 And dwRead > 0 Then
buf = Mid$(buf, 1, dwRead)
GoSub RemoveChr13
stdout = stdout + buf
buf = Space$(4096 + 1)
Else
Exit While
End If
Wend
While ReadFile(hStdOutPipeRead, _Offset(buf), 4096, _Offset(dwRead), 0) <> 0
If dwRead > 0 Then
buf = Mid$(buf, 1, dwRead)
GoSub RemoveChr13
stdout = stdout + buf
buf = Space$(4096 + 1)
End If
Wend
While ReadFile(hStdReadPipeError, _Offset(buf), 4096, _Offset(dwRead), 0) <> 0
If dwRead > 0 Then
buf = Mid$(buf, 1, dwRead)
GoSub RemoveChr13
stderr = stderr + buf
buf = Space$(4096 + 1)
End If
Wend
Dim As Long exit_code, ex_stat
If WaitForSingleObject(procinfo.hProcess, INFINITE) <> WAIT_FAILED Then
If GetExitCodeProcess(procinfo.hProcess, _Offset(exit_code)) Then
ex_stat = 1
End If
End If
HandleClose hStdOutPipeRead
HandleClose hStdReadPipeError
If ex_stat = 1 Then
pipecom = exit_code
Else
pipecom = -1
End If
Exit Function
RemoveChr13:
Dim As Long j
j = InStr(buf, Chr$(13))
Do While j
buf = Left$(buf, j - 1) + Mid$(buf, j + 1)
j = InStr(buf, Chr$(13))
Loop
Return
$Else
Declare CustomType Library
Function popen%& (cmd As String, readtype As String)
Function feof& (ByVal stream As _Offset)
Function fgets$ (str As String, Byval n As Long, Byval stream As _Offset)
Function pclose& (ByVal stream As _Offset)
End Declare
Declare Library
Function WEXITSTATUS& (ByVal stat_val As Long)
End Declare
Dim As _Offset stream
Dim buffer As String * 4096
If _FileExists("pipestderr") Then
Kill "pipestderr"
End If
stream = popen(cmd + " 2>pipestderr", "r")
If stream Then
While feof(stream) = 0
If fgets(buffer, 4096, stream) <> "" And feof(stream) = 0 Then
stdout = stdout + Mid$(buffer, 1, InStr(buffer, Chr$(0)) - 1)
End If
Wend
Dim As Long status, exit_code
status = pclose(stream)
exit_code = WEXITSTATUS(status)
If _FileExists("pipestderr") Then
Dim As Integer errfile
errfile=FREEFILE
Open "pipestderr" For Binary As #errfile
If LOF(errfile) > 0 Then
stderr = Space$(LOF(errfile))
Get #errfile, , stderr
End If
Close #errfile
Kill "pipestderr"
End If
pipecom = exit_code
Else
pipecom = -1
End If
$End If
End Function
Function pipecom_lite$ (cmd As String)
Dim As Long a
Dim As String stdout, stderr
a = pipecom(cmd, stdout, stderr)
If stderr <> "" Then
pipecom_lite = stderr
Else
pipecom_lite = stdout
End If
End Function
$End If
That seems to be more updated than my saved copy. + 1 for the find!
Pete
