TalkChess.com

Code: Select all

Public Sub EngineRun()

    Dim start As STARTUPINFO
    Dim sa As SECURITY_ATTRIBUTES
    Dim L As Long, Result As Long, bSuccess As Long
    Dim Buffer As String
       
    sa.nLength = Len(sa)
    sa.bInheritHandle = 1&
    sa.lpSecurityDescriptor = 0&
    
    
    Result = CreatePipe(hChildStdoutRd, hChildStdoutWr, sa, 1024 * 16)
      
    Result = DuplicateHandle(GetCurrentProcess(), hChildStdoutRd, _
                 GetCurrentProcess(), hChildStdoutRdDup, 0, _
                 False, DUPLICATE_SAME_ACCESS)
      
    If Result = 0 Then
        MsgBox "CreatePipe failed Error!"
        Exit Sub
    End If
    
    CloseHandle hChildStdoutRd
    
    Result = CreatePipe(hChildStdinRd, hChildStdinWr, sa, 0)

    Result = DuplicateHandle(GetCurrentProcess(), hChildStdinWr, _
                 GetCurrentProcess(), hChildStdinWrDup, 0, _
                 False, DUPLICATE_SAME_ACCESS)
                 
    If Result = 0 Then
        MsgBox "CreatePipe failed Error!"
        Exit Sub
    End If
    
    CloseHandle hChildStdinWr

    start.cb = Len(start)
    start.dwFlags = STARTF_USESTDHANDLES
    start.hStdInput = hChildStdinRd
    start.hStdOutput = hChildStdoutWr
    start.hStdError = hChildStdoutWr

    Result = CreateProcessA(0&, EnginePath, 0&, 0&, 1&, &H8000000, 0&, 0&, start, proc)
    
    ProcID = proc.hProcess

    If Result <> 0 Then
        
        Dim lPeekData As Long
        
        Do
            Call PeekNamedPipe&#40;hChildStdoutRdDup, ByVal 0&, 0&, ByVal 0&, lPeekData, ByVal 0&)
            
            If lPeekData > 0 Then
                Buffer = Space$&#40;lPeekData&#41;
                bSuccess = readFile&#40;hChildStdoutRdDup, Buffer, Len&#40;Buffer&#41;, L, 0&)
                
                If bSuccess = 1 Then
		    &#91;...&#93;
                Else
                    MsgBox "ReadFile failed!"
                End If
            Else
                bSuccess = WaitForSingleObject&#40;proc.hProcess, 0&)
                        
                If bSuccess = 0 Then Exit Do
            End If
            
            DoEvents
        Loop
            
    Else
        MsgBox "Error while starting process!"
    End If
    
    TerminateProcess proc.hProcess, 0
    
    Call CloseHandle&#40;proc.hProcess&#41;
    Call CloseHandle&#40;proc.hThread&#41;
    Call CloseHandle&#40;hReadPipe&#41;
    Call CloseHandle&#40;hWritePipe&#41;

End Sub

Public Sub EngineSend&#40;)
    
    Dim b&#40;256&#41;
    Dim data As String
    
    data = "uci" & vbCrLf
    Call CopyMemory&#40;b&#40;0&#41;, data, Len&#40;data&#41;)

    fSuccess = WriteFile&#40;hChildStdinWrDup, b&#40;0&#41;, Len&#40;data&#41;, lBytesWritten, 0&#41;
    
    'FlushFileBuffers hChildStdinWrDup
End Sub

Code: Select all

'===========================================================================
' Pseudo Winboard chess program written by Thomas McBurney August 2005
'
'The following code is only an example of how to communicate with
'Winboard using a pipe.  
'===========================================================================

' Declare my functions and subs.  FreeBASIC gets upset if I don't do it.
declare function GetCommand() as string
declare function SendCommand(byval WBCmd as string) as integer
declare sub Main

' Declare the API functions we will be using for communicating to Winboard
dim KernelLib as integer
dim shared WriteFile as function (BYVAL hFile AS integer, lpBuffer AS ANY, BYVAL nNumberOfBytesToWrite AS integer, lpNumberOfBytesWritten AS integer, lpOverlapped AS ANY) AS integer
dim shared GetStdHandle as function (BYVAL nStdHandle AS integer) AS integer
dim shared ReadFile as function (BYVAL hFile AS integer, lpBuffer AS ANY, BYVAL nNumberOfBytesToRead AS integer, lpNumberOfBytesRead AS integer, lpOverlapped AS ANY) AS integer
dim shared PeekNamedPipe as function (BYVAL hNamedPipe AS integer, lpBuffer AS ANY, BYVAL nBufferSize AS integer, lpBytesRead AS integer, lpTotalBytesAvail AS integer, lpBytesLeftThisMessage AS integer) AS integer

' Link KernelLib to kernel32.dll
KernelLib = dylibload( "KERNEL32" )

' Link the functions to the appropriate Kernel32 library.
WriteFile = dylibsymbol( KernelLib, "WriteFile" )
GetStdHandle = dylibsymbol( KernelLib, "GetStdHandle" )
ReadFile = dylibsymbol( KernelLib, "ReadFile" )
PeekNamedPipe = dylibsymbol( KernelLib, "PeekNamedPipe" )


 DIM STD_OUTPUT_HANDLE AS integer
 DIM STD_INPUT_HANDLE AS integer
 DIM shared OutputHandle AS integer
 DIM shared InputHandle AS integer
 
 STD_OUTPUT_HANDLE = -11&
 STD_INPUT_HANDLE = -10&

 OutputHandle = GetStdHandle(STD_OUTPUT_HANDLE)
 InputHandle = GetStdHandle(STD_INPUT_HANDLE)
 
 call Main



sub Main

dim sWinboardCmd as string
dim sTemp as string

DO
    sWinboardCmd=GetCommand ' Get command from Winboard
    
    if sWinboardCmd<>"" then
        IF sWinboardCmd="protover 2" THEN
            sTemp="feature myname="+CHR$&#40;34&#41;+"Pseudo chess program written in FreeBASIC"+CHR$&#40;34&#41;
            SendCommand&#40;sTemp&#41;
            SendCommand&#40;"feature done=1")
        END IF

        IF sWinboardCmd="quit" THEN EXIT DO ' this will exit the program
        IF sWinboardCmd="e2e4" THEN SendCommand&#40;"move e7e5")
        IF sWinboardCmd="g1f3" THEN SendCommand&#40;"move b8c6")
    END IF
    sleep 10
LOOP  

END SUB 

function GetCommand&#40;) as string

    'This function will retrieve one command at a time from winboard.

    DIM sBuff AS STRING
    DIM iBytesRead AS integer
    DIM iTotalBytes AS integer
    DIM iAvailBytes AS integer
    DIM iReturnCode AS integer
    DIM sTemp as string

    GetCommand=""
    
    ' Null character will make sBuff a C style empty string
    sBuff = CHR$&#40;0&#41; 
    
    ' PeekNamedPipe tells us if there is any data waiting to be retrieved.
     iReturnCode = PeekNamedPipe&#40;InputHandle, BYVAL STRPTR&#40;sBuff&#41;, 1, iBytesRead, iTotalBytes, iAvailBytes&#41;

    ' return empty string when there is no data to be retrieved.
    IF iTotalBytes=0 THEN EXIT function
    

    ' Retrieve data
    DO
        iReturnCode = ReadFile&#40;InputHandle, BYVAL STRPTR&#40;sBuff&#41;, 1, iBytesRead, BYVAL 0&) 
        IF ASC&#40;sBuff&#41;=10 THEN EXIT DO  ' exit on line feed
        sTemp=sTemp+sBuff
    LOOP
    
    GetCommand=sTemp
    
END function

Function SendCommand&#40;Byval sWBCmd As String&#41; As integer

    Dim iBytesWritten As integer
    Dim iBytes As integer
    Dim iReturnCode As integer
    
    sWBCmd = sWBCmd + chr$&#40;10&#41; ' add line feed to end of string
    
    iBytes = Len&#40;sWBCmd&#41;
    iReturnCode = WriteFile&#40;OutputHandle, ByVal sWBCmd, iBytes, lBytesWritten, ByVal 0&)

    SendCommand = 0

End Function