[XE2] Adaptation d'un programme utilisant la fonction CreatePipe

**Roland Chastain** · 26/01/2016, 20h51

Bonjour !

J'ai un programme qui dialogue avec une autre application console (un moteur de jeu d'échecs). Je l'ai compilé avec Free Pascal et Delphi 7 : dans un cas comme dans l'autre il fonctionne parfaitement. Maintenant, avec XE2, j'arrive à le compiler (sans un seul avertissement) mais lorsque je l'exécute il se plante, sans rien afficher. Pourriez-vous m'aider à le corriger ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
program uci_test_01;
 
{$MODE DELPHI}
 
{ http://forum.lazarus.freepascal.org/index.php/topic,14956.msg128820.html#msg128820 }
 
uses
  Windows, Classes, SysUtils;
 
var
  ProcInfo: TProcessInformation;
  InputRead, InputWrite, OutputRead, OutputWrite, ErrorRead, ErrorWrite: THandle;
 
function LoadEngine(const aEngine: string): boolean;
var
  StartInfo: TStartupInfo;
  Security: TSecurityAttributes;
begin
  with Security do
  begin
    nLength := SizeOf(TSecurityAttributes);
    bInheritHandle := TRUE;
    lpSecurityDescriptor := nil;
  end;
 
  CreatePipe(InputRead, InputWrite, @Security, 0);
  CreatePipe(OutputRead, OutputWrite, @Security, 0);
  CreatePipe(ErrorRead, ErrorWrite, @Security, 0);
 
  FillChar(StartInfo, SizeOf(TStartupInfo), #0);
 
  with StartInfo do
  begin
    cb := SizeOf(TStartupInfo);
    hStdInput := InputRead;
    hStdOutput := OutputWrite;
    hStdError := ErrorWrite;
    dwFlags := STARTF_USESTDHANDLES + STARTF_USESHOWWINDOW;
    wShowWindow := SW_HIDE;
  end;
 
  result := CreateProcess(
    nil,
    pchar(aEngine),
    @Security,
    @Security,
    TRUE,
    CREATE_NEW_CONSOLE + SYNCHRONIZE,
    nil,
    nil,
    StartInfo,
    ProcInfo
  );
end;
 
procedure WritePipeOut(OutputPipe: THandle; InString: string);
var
  BytesWritten: DWORD;
begin
  InString := InString + #13#10;
  WriteFile(OutputPipe, InString[1], Length(InString), BytesWritten, nil);
end;
 
function ReadPipeInput(InputPipe: THandle; var BytesRem: Integer): string;
var
  TextBuffer: array[1..32767] of char;
  TextString: string;
  BytesRead: longword;
  PipeSize: integer;
begin
  Result := '';
 
  PipeSize := SizeOf(TextBuffer);
 
  PeekNamedPipe(InputPipe, nil, PipeSize, @BytesRead, @PipeSize, @BytesRem);
 
  if BytesRead > 0 then
  begin
    ReadFile(InputPipe, TextBuffer, PipeSize, BytesRead, nil);
    OemToChar(@TextBuffer, @TextBuffer);
    TextString := string(TextBuffer);
    SetLength(TextString, BytesRead);
    Result := TextString;
  end;
end;
 
procedure CloseHandles;
begin
  CloseHandle(ProcInfo.hProcess);
  CloseHandle(ProcInfo.hThread);
  CloseHandle(InputRead);
  CloseHandle(InputWrite);
  CloseHandle(OutputRead);
  CloseHandle(OutputWrite);
  CloseHandle(ErrorRead);
  CloseHandle(ErrorWrite);
end;
 
var
  BytesRem: longint;
  TextString: string;
 
begin
  if LoadEngine('Houdini_15a_w32.exe') then
  begin
    Sleep(1000);
 
    TextString := ReadPipeInput(OutputRead, BytesRem);
    Write(TextString);
 
    WritePipeOut(InputWrite, 'uci');
    Sleep(1000);
 
    TextString := ReadPipeInput(OutputRead, BytesRem);
    Write(TextString);
 
    WritePipeOut(InputWrite, 'ucinewgame');
    Sleep(1000);
 
    WritePipeOut(InputWrite, 'isready');
    Sleep(1000);
 
    TextString := ReadPipeInput(OutputRead, BytesRem);
    Write(TextString);
 
    WritePipeOut(InputWrite, 'go movetime 1000');
    Sleep(2000);
 
    TextString := ReadPipeInput(OutputRead, BytesRem);
    Write(TextString);
 
    WritePipeOut(InputWrite, 'quit');
    Sleep(1000);
 
    CloseHandles;
  end;
end.

Le programme, lorsqu'il fonctionne, envoie des commandes au moteur d'échecs, capte les réponses et les affiche. Voici ce que ça donne normalement :

Code X :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
Houdini 1.5a w32
(c) 2010-11 Robert Houdart

info string POPCNT available
info string 128 MB Hash
id name Houdini 1.5a w32
id author Robert Houdart
option name Hash type spin min 4 max 1024 default 128
option name Clear Hash type button
option name Threads type spin min 1 max 8 default 8
option name Split_Depth type spin min 8 max 99 default 10
option name Ponder type check default false
option name Contempt type spin min 0 max 2 default 1
option name Analysis_Contempt type check default false
option name MultiPV type spin min 1 max 16 default 1
option name GaviotaTbPath type string default <empty>
option name GaviotaTbCache type spin min 4 max 1024 default 64
option name Hard_Probe_Depth type spin min 2 max 99 default 24
option name Soft_Probe_Depth type spin min 2 max 99 default 16
uciok
readyok
info multipv 1 depth 4 seldepth 18 score cp 5  time 9 nodes 1758 nps 195000 tbhits 0 hashfull 0 pv g1f3 g8f6 b1c3 b8c6 d2d3 e7e6
info multipv 1 depth 5 seldepth 18 score cp 5  time 41 nodes 2057 nps 50000 tbhits 0 hashfull 0 pv g1f3 g8f6 b1c3 b8c6 d2d3 e7e6
info depth 6
info multipv 1 depth 6 seldepth 20 score cp 5  time 48 nodes 3854 nps 80000 tbhits 0 hashfull 0 pv g1f3 g8f6 b1c3 b8c6 d2d3 e7e6
info multipv 1 depth 6 seldepth 20 score cp 12  time 59 nodes 6376 nps 108000 tbhits 0 hashfull 0 pv e2e4 d7d5 b1c3 g8f6 e4e5 f6e4 d2d3
info depth 7
info multipv 1 depth 7 seldepth 21 score cp 13  time 77 nodes 11112 nps 144000 tbhits 0 hashfull 0 pv b1c3 g8f6 e2e4 b8c6 g1f3 e7e6 d2d4 b7b6
info depth 8
info multipv 1 depth 8 seldepth 21 score cp 14  time 98 nodes 17659 nps 180000 tbhits 0 hashfull 0 pv e2e4 d7d5 e4d5 d8d5 b1c3 d5e6 g1e2 g8f6 d2d4 b8c6 c1f4
info depth 9
info multipv 1 depth 9 seldepth 21 score cp 15  time 123 nodes 26243 nps 213000 tbhits 0 hashfull 0 pv e2e4 d7d5 e4d5 g8f6 b1c3 f6d5 g1f3 b8c6 d2d4 g7g6 f1c4 c8e6
info depth 10
info multipv 1 depth 10 seldepth 21 score cp 15  time 198 nodes 45232 nps 228000 tbhits 0 hashfull 6 pv e2e4 d7d5 e4d5 g8f6 b1c3 f6d5 g1f3 b8c6 d2d4 g7g6 f1c4 c8e6
info multipv 1 depth 10 seldepth 23 score cp 21 lowerbound time 282 nodes 78201 nps 277000 tbhits 0 hashfull 8 pv d2d4
info multipv 1 depth 10 seldepth 23 score cp 21  time 303 nodes 85111 nps 280000 tbhits 0 hashfull 8 pv d2d4 d7d5 b1c3 b8c6 g1f3 c8f5 f3h4 e7e6 h4f5 e6f5 c1f4 f8d6
info depth 11
info multipv 1 depth 11 seldepth 27 score cp 17  time 441 nodes 133412 nps 302000 tbhits 0 hashfull 12 pv d2d4 g8f6 g1f3 e7e6 c1f4 f6d5 f4g5 f7f6 e2e4 b7b6 e4d5 f6g5
info depth 12
info multipv 1 depth 12 seldepth 32 score cp 10 upperbound time 613 nodes 196178 nps 320000 tbhits 0 hashfull 16 pv d2d4 g8f6
info multipv 1 depth 12 seldepth 32 score cp 10  time 1005 nodes 352815 nps 351000 tbhits 0 hashfull 30 pv d2d4 g8f6 g1f3 e7e6 c1f4 f6d5 f4g5 f7f6 e2e4 b7b6 e4d5 f6g5 d5e6 d7e6 f3e5
bestmove d2d4 ponder g8f6

**Roland Chastain** · 26/01/2016, 23h40

Bon, apparemment j'y suis arrivé tout seul.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
program uci_test_01;
 
{$APPTYPE CONSOLE}
{$IFDEF FPC}{$MODE DELPHI}{$ENDIF}
 
{ http://forum.lazarus.freepascal.org/index.php/topic,14956.msg128820.html#msg128820 }
 
uses
  Windows, Classes, SysUtils;
 
var
  ProcInfo: TProcessInformation;
  InputRead, InputWrite, OutputRead, OutputWrite, ErrorRead, ErrorWrite: THandle;
 
function LoadEngine(const aEngine: {string}ansistring): boolean;
var
  StartInfo: {TStartupInfo}_STARTUPINFOA;
  Security: TSecurityAttributes;
begin
  with Security do
  begin
    nLength := SizeOf(TSecurityAttributes);
    bInheritHandle := TRUE;
    lpSecurityDescriptor := nil;
  end;
 
  CreatePipe(InputRead, InputWrite, @Security, 0);
  CreatePipe(OutputRead, OutputWrite, @Security, 0);
  CreatePipe(ErrorRead, ErrorWrite, @Security, 0);
 
  FillChar(StartInfo, SizeOf({TStartupInfo}_STARTUPINFOA), #0);
 
  with StartInfo do
  begin
    cb := SizeOf({TStartupInfo}_STARTUPINFOA);
    hStdInput := InputRead;
    hStdOutput := OutputWrite;
    hStdError := ErrorWrite;
    dwFlags := STARTF_USESTDHANDLES + STARTF_USESHOWWINDOW;
    wShowWindow := SW_HIDE;
  end;
 
  //result := CreateProcess(
  result := CreateProcessA(
    nil,
    {pchar}pansichar(aEngine),
    @Security,
    @Security,
    TRUE,
    CREATE_NEW_CONSOLE + SYNCHRONIZE,
    nil,
    nil,
    StartInfo,
    ProcInfo
  );
end;
 
procedure WritePipeOut(OutputPipe: THandle; InString: {string}ansistring);
var
  BytesWritten: DWORD;
begin
  InString := InString + #13#10;
  WriteFile(OutputPipe, InString[1], Length(InString), BytesWritten, nil);
end;
 
function ReadPipeInput(InputPipe: THandle; var BytesRem: Integer): {string}ansistring;
var
  TextBuffer: array[1..32767] of {char}ansichar;
  TextString: {string}ansistring;
  BytesRead: longword;
  PipeSize: integer;
begin
  Result := '';
 
  PipeSize := SizeOf(TextBuffer);
 
  PeekNamedPipe(InputPipe, nil, PipeSize, @BytesRead, @PipeSize, @BytesRem);
 
  if BytesRead > 0 then
  begin
    ReadFile(InputPipe, TextBuffer, PipeSize, BytesRead, nil);
    OemToChar(@TextBuffer, @TextBuffer);
    TextString := {string}ansistring(TextBuffer);
    SetLength(TextString, BytesRead);
    Result := TextString;
  end;
end;
 
procedure CloseHandles;
begin
  CloseHandle(ProcInfo.hProcess);
  CloseHandle(ProcInfo.hThread);
  CloseHandle(InputRead);
  CloseHandle(InputWrite);
  CloseHandle(OutputRead);
  CloseHandle(OutputWrite);
  CloseHandle(ErrorRead);
  CloseHandle(ErrorWrite);
end;
 
var
  BytesRem: longint;
  TextString: {string}ansistring;
 
begin
  if LoadEngine('Houdini_15a_w32.exe') then
  begin
    Sleep(1000);
 
    TextString := ReadPipeInput(OutputRead, BytesRem);
    Write(TextString);
 
    WritePipeOut(InputWrite, 'uci');
    Sleep(1000);
 
    TextString := ReadPipeInput(OutputRead, BytesRem);
    Write(TextString);
 
    WritePipeOut(InputWrite, 'ucinewgame');
    Sleep(1000);
 
    WritePipeOut(InputWrite, 'isready');
    Sleep(1000);
 
    TextString := ReadPipeInput(OutputRead, BytesRem);
    Write(TextString);
 
    WritePipeOut(InputWrite, 'go movetime 1000');
    Sleep(2000);
 
    TextString := ReadPipeInput(OutputRead, BytesRem);
    Write(TextString);
 
    WritePipeOut(InputWrite, 'quit');
    Sleep(1000);
 
    CloseHandles;
  end;
end.

[XE2] Adaptation d'un programme utilisant la fonction CreatePipe

API, COM et SDKs Delphi

Discussions similaires

Partager

Partager