Как организовать обмен данными с Шахматным Движком? - VB

Option Explicit
 
Private Declare Function CreatePipe Lib "kernel32" (phReadPipe As Long, phWritePipe As Long, lpPipeAttributes As SECURITY_ATTRIBUTES, ByVal nSize As Long) As Long
Private Declare Function PeekNamedPipe Lib "kernel32" (ByVal hNamedPipe As Long, lpBuffer As Any, ByVal nBufferSize As Long, lpBytesRead As Long, lpTotalBytesAvail As Long, lpBytesLeftThisMessage As Any) As Long
Private Declare Sub GetStartupInfo Lib "kernel32" Alias "GetStartupInfoW" (lpStartupInfo As STARTUPINFO)
Private Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessW" (ByVal lpApplicationName As Long, ByVal lpCommandLine As Long, lpProcessAttributes As Any, lpThreadAttributes As Any, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, lpEnvironment As Any, ByVal lpCurrentDriectory As Long, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) 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 WriteFile Lib "kernel32" (ByVal hFile As Long, ByVal lpBuffer As Long, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
 
Private Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Long
End Type
Private Type PROCESS_INFORMATION
    hProcess As Long
    hThread As Long
    dwProcessId As Long
    dwThreadId 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 Byte
    hStdInput As Long
    hStdOutput As Long
    hStdError As Long
End Type
Private Type PIPE
    hRead As Long
    hWrite As Long
End Type
 
Private Const CREATE_NEW_CONSOLE = &H10
Private Const STARTF_USESHOWWINDOW = &H1
Private Const STARTF_USESTDHANDLES = &H100
Private Const SW_HIDE = 0
 
Dim PipeIn As PIPE, PipeOut As PIPE, pi As PROCESS_INFORMATION
 
Private Function conWrite(ByVal sData As String) As Boolean
    Dim lBytesWrote As Long
 
    sData = StrConv(sData, vbFromUnicode)
 
    If WriteFile(PipeIn.hWrite, StrPtr(sData), LenB(sData), lBytesWrote, 0&) Then
    
        If lBytesWrote = LenB(sData) Then conWrite = True
    End If
End Function
 
Private Function conRead() As String
    Dim buf As String, count As Long
    
    PeekNamedPipe PipeOut.hRead, ByVal 0&, 0&, ByVal 0&, count, ByVal 0&
    If count > 0 Then
        buf = String$((count + 1) \ 2, 0&)
        If ReadFile(PipeOut.hRead, ByVal StrPtr(buf), count, count, ByVal 0&) Then
            conRead = DOS2Win(StrConv(Left$(buf, count), vbUnicode))
        End If
    End If
End Function
Private Function InitConsole(CommandLine As String, nShow As Long) As Boolean
    Dim attr As SECURITY_ATTRIBUTES
    Dim sui As STARTUPINFO
    
    attr.nLength = Len(attr)
    attr.lpSecurityDescriptor = 0
    attr.bInheritHandle = True
    
    If CreatePipe(PipeIn.hRead, PipeIn.hWrite, attr, 0) <> 0 Then
    
      If CreatePipe(PipeOut.hRead, PipeOut.hWrite, attr, 0) <> 0 Then
      
        sui.cb = Len(sui)
        GetStartupInfo sui
        sui.hStdInput = PipeIn.hRead
        sui.hStdOutput = PipeOut.hWrite
        sui.hStdError = PipeOut.hWrite
        sui.dwFlags = STARTF_USESHOWWINDOW Or STARTF_USESTDHANDLES
        sui.wShowWindow = nShow
        If CreateProcess(0&, StrPtr(CommandLine), ByVal 0, ByVal 0, 1&, CREATE_NEW_CONSOLE, ByVal 0, 0&, sui, pi) = 0 Then
            DeinitConsole
            MsgBox "CreateProcess failed with code " & Err.LastDllError
        Else
            InitConsole = True
        End If
      End If
    End If
End Function
Private Function DOS2Win(ByVal Str As String) As String
     Dim i As Long
     For i = 239 To 192 Step -1
         Str = Replace(Str, Chr(i), Chr(i + 16))
     Next i
     For i = 191 To 128 Step -1
         Str = Replace(Str, Chr(i), Chr(i + 64))
     Next i
     Str = Replace$(Str, Chr(0), "")
     DOS2Win = Str
End Function
Private Sub DeinitConsole()
    If pi.hProcess <> 0 Then TerminateProcess pi.hProcess, 0&
    CloseHandle PipeIn.hRead: CloseHandle PipeIn.hWrite
    CloseHandle PipeOut.hWrite: CloseHandle PipeOut.hWrite
    CloseHandle pi.hThread: CloseHandle pi.hProcess
End Sub
Private Sub Form_Load()
    Dim s As String
 
    If InitConsole("C:\Windows\System32\Cmd.exe", SW_HIDE) Then
 
        conWrite "@echo off" & vbCrLf
        conWrite "echo %SystemRoot%" & vbCrLf
 
        Stop
 
        s = conRead()
        MsgBox s
 
        DeinitConsole
    End If
 
    End
End Sub
Private Sub Form_Unload(Cancel As Integer)
    DeinitConsole
End Sub