This is a work in progress and I don't know if I ever implement all possible stuff.
Code: Select all
;
; RunProgramConPTY.pbi
;
; by infratec
;
; https://www.purebasic.fr/english/viewtopic.php?t=88449
;
; 2026.03.01 16:00 initial upload
; 2026.03.01 17:02 added the write procedures
; 2026.03.01 18:14 added a Mutex for reading
; 2026.03.01 20:17 check the Mutex before using it
;
CompilerIf Not #PB_Compiler_Thread
CompilerError "Enable threadsafe option!"
CompilerEndIf
CompilerIf #PB_Compiler_IsMainFile
EnableExplicit
CompilerEndIf
#PROC_THREAD_ATTRIBUTE_PSEUDOCONSOLE = $00020016
#EXTENDED_STARTUPINFO_PRESENT = $00080000
#HANDLE_FLAG_INHERIT = 1
#HANDLE_FLAG_PROTECT_FROM_CLOSE = 2
Structure STARTUPINFOEX
StartupInfo.STARTUPINFO
*lpAttributeList
EndStructure
Structure RunProgramConPTY_Structure
Id.i
Flags.i
hPipePTYInR.i
hPipePTYInW.i
hPipePTYOutR.i
hPipePTYOutW.i
sa.SECURITY_ATTRIBUTES
si.STARTUPINFOEX
pi.PROCESS_INFORMATION
hPC.i
Thread.i
ReadThread.i
*BufferRead
BufferReadMutex.i
exitCode.l
window.i
Exit.i
EndStructure
Prototype.l Proto_CreatePseudoConsole(size.l, hInput.i, hOutput.i, dwFlags.l, *phPC)
Prototype Proto_ClosePseudoConsole(hPC.i)
Prototype.l Proto_InitializeProcThreadAttributeList(*lpAttributeList, dwAttributeCount.l, dwFlags.l, *lpSize)
Prototype.l Proto_UpdateProcThreadAttribute(*lpAttributeList, dwFlags.l, *Attribute, *lpValue, cbSize.i, *lpPreviousValue, *lpReturnSize)
Prototype Proto_DeleteProcThreadAttributeList(*lpAttributeList)
Global CreatePseudoConsole.Proto_CreatePseudoConsole
Global ClosePseudoConsole.Proto_ClosePseudoConsole
Global InitializeProcThreadAttributeList.Proto_InitializeProcThreadAttributeList
Global UpdateProcThreadAttribute.Proto_UpdateProcThreadAttribute
Global DeleteProcThreadAttributeList.Proto_DeleteProcThreadAttributeList
Global NewMap RunProgramConPTYMap.RunProgramConPTY_Structure()
XIncludeFile "RemoveANSIEscapeCodes.pbi"
Define RunProgramConPTY_kernel32.i
RunProgramConPTY_kernel32 = OpenLibrary(#PB_Any, "Kernel32.dll")
If RunProgramConPTY_kernel32
CreatePseudoConsole = GetFunction(RunProgramConPTY_kernel32, "CreatePseudoConsole")
ClosePseudoConsole = GetFunction(RunProgramConPTY_kernel32, "ClosePseudoConsole")
InitializeProcThreadAttributeList = GetFunction(RunProgramConPTY_kernel32, "InitializeProcThreadAttributeList")
UpdateProcThreadAttribute = GetFunction(RunProgramConPTY_kernel32, "UpdateProcThreadAttribute")
DeleteProcThreadAttributeList = GetFunction(RunProgramConPTY_kernel32, "DeleteProcThreadAttributeList")
EndIf
Procedure RunProgramConPTYReadThread(*RunProgramConPTY.RunProgramConPTY_Structure)
Protected *Buffer, BufferPtr.i, bytesRead.l
*Buffer = AllocateMemory(4096)
If *Buffer
Repeat
If ReadFile_(*RunProgramConPTY\hPipePTYOutR, *Buffer, MemorySize(*Buffer), @bytesRead, #Null) And bytesRead > 0
; Debug bytesRead
If *RunProgramConPTY\BufferReadMutex
LockMutex(*RunProgramConPTY\BufferReadMutex)
If *RunProgramConPTY\BufferRead = #Null
*RunProgramConPTY\BufferRead = AllocateMemory(bytesRead, #PB_Memory_NoClear)
BufferPtr = 0
Else
BufferPtr = MemorySize(*RunProgramConPTY\BufferRead)
*RunProgramConPTY\BufferRead = ReAllocateMemory(*RunProgramConPTY\BufferRead, BufferPtr + bytesRead)
EndIf
;ShowMemoryViewer(*Buffer, bytesRead)
CopyMemory(*Buffer, *RunProgramConPTY\BufferRead + BufferPtr, bytesRead)
UnlockMutex(*RunProgramConPTY\BufferReadMutex)
EndIf
EndIf
Until *RunProgramConPTY\Exit
FreeMemory(*Buffer)
EndIf
EndProcedure
Procedure RunProgramConPTYThread(*RunProgramConPTY.RunProgramConPTY_Structure)
Protected ExitCode.l
If *RunProgramConPTY\Flags & #PB_Program_Read
*RunProgramConPTY\ReadThread = CreateThread(@RunProgramConPTYReadThread(), *RunProgramConPTY)
EndIf
ExitCode = #STILL_ACTIVE
Repeat
If ExitCode = #STILL_ACTIVE
GetExitCodeProcess_(*RunProgramConPTY\pi\hProcess, @exitCode)
Delay(10)
Else
Delay(100) ; to allow processing of Read
*RunProgramConPTY\exitCode = ExitCode
EndIf
Until *RunProgramConPTY\Exit
EndProcedure
Procedure.i IsProgramConPTY(Program.i)
Protected Result.i
If FindMapElement(RunProgramConPTYMap(), Str(Program))
Result = #True
EndIf
ProcedureReturn Result
EndProcedure
Procedure.i ProgramRunningConPTY(Program.i)
Protected Result.i, *RunProgramConPTY.RunProgramConPTY_Structure
*RunProgramConPTY = FindMapElement(RunProgramConPTYMap(), Str(Program))
If *RunProgramConPTY
If *RunProgramConPTY\exitCode = #STILL_ACTIVE
Result = #True
EndIf
EndIf
ProcedureReturn Result
EndProcedure
Procedure.i AvailableProgramOutputConPTY(Program.i)
Protected Result.i, *RunProgramConPTY.RunProgramConPTY_Structure
*RunProgramConPTY = FindMapElement(RunProgramConPTYMap(), Str(Program))
If *RunProgramConPTY
If *RunProgramConPTY\BufferRead
Result = MemorySize(*RunProgramConPTY\BufferRead)
EndIf
EndIf
ProcedureReturn Result
EndProcedure
Procedure.i ReadProgramDataConPTY(Program.i, *Buffer, Size.i)
Protected Result.i, *RunProgramConPTY.RunProgramConPTY_Structure
*RunProgramConPTY = FindMapElement(RunProgramConPTYMap(), Str(Program))
If *RunProgramConPTY
LockMutex(*RunProgramConPTY\BufferReadMutex)
If Size > MemorySize(*RunProgramConPTY\BufferRead)
Size = MemorySize(*RunProgramConPTY\BufferRead)
EndIf
CopyMemory(*RunProgramConPTY\BufferRead, *Buffer, Size)
If Size = MemorySize(*RunProgramConPTY\BufferRead)
FreeMemory(*RunProgramConPTY\BufferRead)
*RunProgramConPTY\BufferRead = #Null
Else
MoveMemory(*RunProgramConPTY\BufferRead + Size, *RunProgramConPTY\BufferRead, MemorySize(*RunProgramConPTY\BufferRead) - Size)
*RunProgramConPTY\BufferRead = ReAllocateMemory(*RunProgramConPTY\BufferRead, MemorySize(*RunProgramConPTY\BufferRead) - Size)
EndIf
UnlockMutex(*RunProgramConPTY\BufferReadMutex)
EndIf
ProcedureReturn Size
EndProcedure
Procedure.s ReadProgramStringConPTY(Program.i)
Protected *RunProgramConPTY.RunProgramConPTY_Structure, Result$, *CharPtr.Ascii, *BufferEnd
*RunProgramConPTY = FindMapElement(RunProgramConPTYMap(), Str(Program))
If *RunProgramConPTY
Repeat
LockMutex(*RunProgramConPTY\BufferReadMutex)
If *RunProgramConPTY\BufferRead
*BufferEnd = *RunProgramConPTY\BufferRead + MemorySize(*RunProgramConPTY\BufferRead) - 1
*CharPtr = *RunProgramConPTY\BufferRead
While *CharPtr < *BufferEnd
If *CharPtr\a = #CR
;ShowMemoryViewer(*RunProgramConPTY\BufferRead, MemorySize(*RunProgramConPTY\BufferRead))
*CharPtr + 1
If *CharPtr\a = #LF
Result$ = PeekS(*RunProgramConPTY\BufferRead, *CharPtr - *RunProgramConPTY\BufferRead + 1, #PB_ByteLength|#PB_UTF8)
*CharPtr + 1
Else
Result$ = PeekS(*RunProgramConPTY\BufferRead, *CharPtr - *RunProgramConPTY\BufferRead, #PB_ByteLength|#PB_UTF8)
EndIf
If *CharPtr < *BufferEnd
;Debug "NotEnd"
MoveMemory(*CharPtr, *RunProgramConPTY\BufferRead, *BufferEnd - *CharPtr + 1)
*RunProgramConPTY\BufferRead = ReAllocateMemory(*RunProgramConPTY\BufferRead, *BufferEnd - *CharPtr + 1)
;ShowMemoryViewer(*RunProgramConPTY\BufferRead, MemorySize(*RunProgramConPTY\BufferRead))
Else
FreeMemory(*RunProgramConPTY\BufferRead)
*RunProgramConPTY\BufferRead = #Null
EndIf
Break
EndIf
*CharPtr + 1
Wend
EndIf
UnlockMutex(*RunProgramConPTY\BufferReadMutex)
Until Result$ <> "" Or *RunProgramConPTY\exitCode <> #STILL_ACTIVE
EndIf
ProcedureReturn Result$
EndProcedure
Procedure.i WriteProgramDataConPTY(Program.i, *Buffer, Size.l)
Protected Result.i, *RunProgramConPTY.RunProgramConPTY_Structure, BytesWritten.l
*RunProgramConPTY = FindMapElement(RunProgramConPTYMap(), Str(Program))
If *RunProgramConPTY
If *RunProgramConPTY\Flags & (#PB_Program_Open | #PB_Program_Write) = #PB_Program_Open | #PB_Program_Write
If Not WriteFile_(*RunProgramConPTY\hPipePTYInW, *Buffer, Size, @BytesWritten, #Null)
BytesWritten = 0
EndIf
EndIf
EndIf
ProcedureReturn BytesWritten
EndProcedure
Procedure.i WriteProgramStringConPTY(Program.i, String$)
Protected Result.i, *RunProgramConsole.RunProgramConPTY_Structure, BytesWritten.i, *Buffer
*RunProgramConsole = FindMapElement(RunProgramConPTYMap(), Str(Program))
If *RunProgramConsole
*Buffer = AllocateMemory(StringByteLength(String$, #PB_UTF8), #PB_Memory_NoClear)
If *Buffer
PokeS(*Buffer, String$, -1, #PB_UTF8|#PB_String_NoZero)
BytesWritten = WriteProgramDataConPTY(Program, *Buffer, MemorySize(*Buffer))
FreeMemory(*Buffer)
EndIf
EndIf
ProcedureReturn BytesWritten
EndProcedure
Procedure.i WriteProgramStringNConPTY(Program.i, String$)
ProcedureReturn WriteProgramStringConPTY(Program.i, String$ + #CR$)
EndProcedure
Procedure CloseProgramConPTY(Program.i)
Protected *RunProgramConPTY.RunProgramConPTY_Structure
*RunProgramConPTY = FindMapElement(RunProgramConPTYMap(), Str(Program))
If *RunProgramConPTY
*RunProgramConPTY\Exit = #True
If WaitThread(*RunProgramConPTY\Thread, 500) = 0
Debug "Should never happen"
KillThread(*RunProgramConPTY\Thread)
EndIf
If *RunProgramConPTY\BufferReadMutex
FreeMutex(*RunProgramConPTY\BufferReadMutex)
*RunProgramConPTY\BufferReadMutex = 0
EndIf
; --- Cleanup ---
CloseHandle_(*RunProgramConPTY\pi\hProcess)
CloseHandle_(*RunProgramConPTY\pi\hThread)
ClosePseudoConsole(*RunProgramConPTY\hPC)
DeleteProcThreadAttributeList(*RunProgramConPTY\si\lpAttributeList)
FreeMemory(*RunProgramConPTY\si\lpAttributeList)
CloseHandle_(*RunProgramConPTY\hPipePTYOutR)
CloseHandle_(*RunProgramConPTY\hPipePTYInW)
DeleteMapElement(RunProgramConPTYMap(), Str(Program))
EndIf
EndProcedure
Procedure RunProgramConPTYWindowCallBack()
Debug "WindowCallBack"
EndProcedure
Procedure.i RunProgramConPTY(Filename$, Parameter$="", WorkingDirectory$="", Flags.i=0)
Protected.i Id
Protected.l Size
Protected.q attrSize
Protected cmd$
Protected *lpCurrentDirectory
Protected coord.COORD
Protected *RunProgramConPTY.RunProgramConPTY_Structure
Id = MapSize(RunProgramConPTYMap()) + 1
*RunProgramConPTY = AddMapElement(RunProgramConPTYMap(), Str(Id))
*RunProgramConPTY\Id = Id
*RunProgramConPTY\Flags = Flags
; --- Create pipes for ConPTY ---
*RunProgramConPTY\sa\nLength = SizeOf(SECURITY_ATTRIBUTES)
*RunProgramConPTY\sa\bInheritHandle = #True
CreatePipe_(@*RunProgramConPTY\hPipePTYInR, @*RunProgramConPTY\hPipePTYInW, @*RunProgramConPTY\sa, 0)
CreatePipe_(@*RunProgramConPTY\hPipePTYOutR, @*RunProgramConPTY\hPipePTYOutW, @*RunProgramConPTY\sa, 0)
; The PTY side must NOT be inherited by child
SetHandleInformation_(*RunProgramConPTY\hPipePTYOutR, #HANDLE_FLAG_INHERIT, 0)
SetHandleInformation_(*RunProgramConPTY\hPipePTYInW, #HANDLE_FLAG_INHERIT, 0)
; --- Create pseudo console ---
coord\X = 80
coord\Y = 40
Size = coord\y << 16 | coord\x
If CreatePseudoConsole(Size, *RunProgramConPTY\hPipePTYInR, *RunProgramConPTY\hPipePTYOutW, 0, @*RunProgramConPTY\hPC) = #S_OK
InitializeProcThreadAttributeList(#Null, 1, 0, @attrSize)
*RunProgramConPTY\si\lpAttributeList = AllocateMemory(attrSize)
InitializeProcThreadAttributeList(*RunProgramConPTY\si\lpAttributeList, 1, 0, @attrSize)
UpdateProcThreadAttribute(*RunProgramConPTY\si\lpAttributeList, 0, #PROC_THREAD_ATTRIBUTE_PSEUDOCONSOLE, *RunProgramConPTY\hPC, SizeOf(Integer), #Null, #Null)
*RunProgramConPTY\si\StartupInfo\cb = SizeOf(STARTUPINFOEX)
If Flags & #PB_Program_Hide = 0
*RunProgramConPTY\si\StartupInfo\dwFlags = #STARTF_USESHOWWINDOW
*RunProgramConPTY\si\StartupInfo\wShowWindow = #SW_SHOW
EndIf
cmd$ = Filename$ + " " + Parameter$
;Debug cmd$
If WorkingDirectory$ <> ""
*lpCurrentDirectory = @WorkingDirectory$
EndIf
If CreateProcess_(#Null, @cmd$, #Null, #Null, #False, #EXTENDED_STARTUPINFO_PRESENT, #Null, *lpCurrentDirectory, @*RunProgramConPTY\si, @*RunProgramConPTY\pi)
; --- Close handles not needed ---
CloseHandle_(*RunProgramConPTY\hPipePTYInR) ; read from input
CloseHandle_(*RunProgramConPTY\hPipePTYOutW) ; write to output
If *RunProgramConPTY\Flags & #PB_Program_Hide = 0
; *RunProgramConPTY\window = OpenWindow(#PB_Any, 0, 0, 800, 400, "", #PB_Window_MinimizeGadget|#PB_Window_ScreenCentered)
; SetWindowColor(*RunProgramConPTY\window, #Black)
; BindEvent(#PB_Event_CloseWindow, @RunProgramConsoleWindowCallBack(), *RunProgramConPTY\window)
EndIf
Delay(100) ; needed by x64
*RunProgramConPTY\exitCode = #STILL_ACTIVE
If Flags & #PB_Program_Open
If Flags & #PB_Program_Read
*RunProgramConPTY\BufferReadMutex = CreateMutex()
EndIf
*RunProgramConPTY\Thread = CreateThread(@RunProgramConPTYThread(), *RunProgramConPTY)
EndIf
If Flags & #PB_Program_Wait
While *RunProgramConPTY\exitCode = #STILL_ACTIVE
Delay(10)
Wend
CloseProgramConPTY(Id)
EndIf
EndIf
EndIf
ProcedureReturn Id
EndProcedure
;-Demo
CompilerIf #PB_Compiler_IsMainFile
#Compiler$ = #DQUOTE$ + #PB_Compiler_Home + "Compilers\pbcompilerc.exe" + #DQUOTE$
Define Prog.i, Length.i, Out$, *Buffer, SendState.i
;Prog = RunProgramConPTY(#Compiler$, #PB_Compiler_FilePath + "MySource.pb /PREPROCESS " + #PB_Compiler_FilePath + "FullSource.pb", "", #PB_Program_Open|#PB_Program_Read)
Prog = RunProgramConPTY("cmd", "", "", #PB_Program_Open|#PB_Program_Read|#PB_Program_Write)
If Prog
*Buffer = AllocateMemory(4096)
If *Buffer
While ProgramRunningConPTY(Prog)
Length = AvailableProgramOutputConPTY(Prog)
If Length
If ReadProgramDataConPTY(Prog, *Buffer, Length)
Out$ = PeekS(*Buffer, Length, #PB_ByteLength|#PB_UTF8)
;Debug Out$
Out$ = RemoveANSIEscapeCodes(@Out$)
Debug Out$
If Right(RTrim(Out$), 1) = ">"
Select SendState
Case 0
WriteProgramStringNConPTY(Prog, "date /t")
SendState = 1
Case 1
WriteProgramStringNConPTY(Prog, "exit")
SendState = 2
EndSelect
EndIf
EndIf
EndIf
;Out$ + ReadProgramStringConPTY(Prog)
Wend
FreeMemory(*Buffer)
EndIf
CloseProgramConPTY(Prog)
EndIf
CompilerEndIf
Code: Select all
;
; RemoveANSIEscapeCodes.pbi
;
CompilerIf #PB_Compiler_IsMainFile
EnableExplicit
CompilerEndIf
Procedure.s RemoveANSIEscapeCodes(*CharPtr.Character)
Protected Clean$, Char.c, State.i
If *CharPtr
While *CharPtr\c
If *CharPtr\c = #ESC
; Jump behind the first letter, which terminates the escape sequence
*CharPtr + 2
State = 0
While *CharPtr\c
Char = *CharPtr\c
Select State
Case 0
Select Char
Case ']'
State = 1
Case '['
State = 11
EndSelect
Case 1
If Char = '0'
State = 2 ; set window title
Else
State = 0
Break
EndIf
Case 2
If Char = ';' ; following text is the window title up to BEL
State = 3
Else
State = 0
Break
EndIf
Case 3
If Char = #BEL
State = 0
*CharPtr + 2
Break
EndIf
Case 11
If (Char >= '@' And Char <= 'Z') Or (Char >= 'a' And Char <= '~')
State = 0
*CharPtr + 2
Break
EndIf
EndSelect
*CharPtr + 2
Wend
Else
Clean$ + Chr(*CharPtr\c)
*CharPtr + 2
EndIf
Wend
EndIf
ProcedureReturn Clean$
EndProcedure


