Discussion :

[NGeVtC87]

Bonjour,

Je développe sous Delphi 2005. Au lancement de mon application je créer un fichier Texte. Je lance un programme Shell qui me redirige la sortie d'un exe (Externe à mon application) dans ce fichier txt.
Quand j'ouvre mon fichier texte en lecture pour récupérer l'information redirigé. J'ai une exception EInOutError qui est levé (E/S 32). Voila mon code

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
 
  // Création du fichier
  fileName := 'file.txt' 
  assignfile(_textFile,fileName);
  ReWrite(_textFile);
  closeFile(_textFile)
 
   // Launch the batch file and generate a file halcon id
  ShellExecute(0,'open', 'batFile.bat' ,'soft.exe '+fileName,nil,SW_HIDE); // Redirection de la sortie du soft dans un fichier TXT
 
  sleep(1000) // Laisser le temps d'écrire dans le fichier
 
  Reset(_textFile);       // Point où l'exception est levée
 
 while (not EOF(_textFile)) do
 begin
  { Traitement sur le fichier }
 end;
 
 close(_textFile);

Il faut que je signale que cette exception n'est pas levée à chaque lancement du soft mais quelques fois seulement et la fréquence de son apparition diffère d'un pc à un autre.

Est ce qu'il y aurait un moyen de sécuriser cette lecture et ne plus avoir cette exception

Merci

[Andnotor]

Si cet autre programme ouvre ce fichier en exclusif, tu ne pourras pas faire grand chose à part gérer l'exception, attendre quelques instants et refaire un nouvel essai.

[gbegreg]

Bonjour,

Plutôt que de faire ShellExecute, regarde du côté de la fonction CreateProcess de l'API Windows.
Après l'appel à CreateProcess, tu peux attendre la fin du process qui vient d'être créé :

Code :

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

1
2
3
4
5
 
    while WaitForSingleObject(leProcessInformation.hProcess, 50) = WAIT_TIMEOUT	do
    begin
       application.ProcessMessages;
    end;

où leProcessInformation est le TPROCESSINFORMATION passé en dernier paramètre à CreateProcess.

Ainsi, ton code Delphi se poursuivra qu'une fois le process créé terminé. A noter, avec CreateProcess, tu peux également récupérer la sortie standard et la sortie des erreurs du process à exécuter. Du coup, il est peut être possible que tu te passes du .bat.

Enfin, il existe également un composant gratuit nommé DOSCommand (disponible via GetIt sur les nouvelles versions de Delphi, je ne sais pas s'il est compatible avec Delphi 2005...).

[NGeVtC87]

Merci pour votre aide.

La solution avec CreateProcess est intéressante mais j'utilise un programme bat car j'appelle une exécutable qui prend des arguments en entrée. Ce qui se fait très bien avec ShellExecute, je sais pas si le cas avec CreatProcess ?

Je signale que l'exécutable écris dans un fichier. Est ce que CreatProcess + WaitForSingleObject attend la fin de l'écriture ?

Je voulais savoir si une solution ou je capture l’exception EInOutError et je boucle jusqu'à ce L'écriture sur fichier soit terminé. Comme ci dessous:

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
 
isFileAvailable := false;
 
while(not isFileAvailable) do
begin
  try
    Reset(_textFile);       // Point où l'exception est levée
 
    while (not EOF(_textFile)) do
    begin
      { Traitement sur le fichier }
    end;
 
    close(_textFile);
    isFileAvailable := true;
 
  except
     On E : EInOutError do
           isFileAvailable := false; 
  end; 
 
end;

Je donne cette exemple car comme je l'ai dit avant cette exception n'est levée que quelques fois et donc cette solution pourrait marcher lors de quelques exécutions alors que je cherche une solution permanente

[Andnotor]

On peut attendre par CreateProcess ou ShellExecuteEx. Faut-il encore savoir quoi attendre

Dans l'exemple de nassim1987, c'est batfile.bat qui sera synchronisé, pas soft.exe. Il faut donc que batfile.bat lance soft.exe et attende lui-aussi sa terminaison (START /WAIT).
Que fait batfile.bat ? Ne peux-tu pas appeler soft.exe directement en lui passant les bons paramètres ?

Sinon, je verrais la boucle ainsi :

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
Count := 0;
 
while TRUE do
try
  Reset(_textFile);
  Break;
except
  //Un nombre de tentatives max.
  if Count > 9 then
    Raise
  else
  begin
    inc(Count);
    Sleep(1000);
  end;
end;
 
while (not EOF(_textFile)) do
...

[gbegreg]

Comme le dit Andnotor, il faut savoir quoi attendre . CreateProcess ne va pas attendre la fin de l'écriture du fichier mais la fin du process qui est lancé par CreateProcess.
Si tu utilises juste le .bat pour passer les paramètres à soft.exe, tu peux très bien utiliser CreateProcess. Voici un exemple simple (simple car on attend la fin du process mais on ne récupère pas la sortie standard ni la sortie des erreurs) :

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
 
var
  StartInfo : TStartupInfo;
  ProcessInformation : TProcessInformation;
  ligneDeCommande, repCourant : string;
 
begin
  ZeroMemory(@StartInfo, sizeof(StartInfo)); // remplie de 0 StartInfo
  StartInfo.cb:=sizeof(StartInfo);
  StartInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
  StartInfo.wShowWindow := SW_SHOWNOACTIVATE;
 
  // Exemple de valeur à renseigner
  repcourant := 'c:\test';
  ligneDecommande := '"c:\test\soft.exe" "'+param1+'" "'+param2+'"'; // Attention à bien placer des " s'il y a des espaces dans les paramètres par exemple...
 
  if CreateProcess(nil,PWideChar(ligneDeCommande),nil,nil,true,NORMAL_PRIORITY_CLASS and CREATE_UNICODE_ENVIRONMENT,nil,PWideChar(repCourant),StartInfo,ProcessInformation)
  then
  begin
    while WaitForSingleObject(ProcessInformation.hProcess, 50) = WAIT_TIMEOUT	do
    begin
       application.ProcessMessages;
    end;
  end;
 
  // Faire ici le traitement sur le fichier 
 
end;

[LadyWasky]

Vous avez un anti-virus en tache de fond ?

[LadyWasky]

En plus, sleep(1000), ça se fait pas dans ce genre de cas, c'est moche, bon sang que c'est laid ! Il suffit que le .bat mette 1,1seconde pour se lancer puis s'exécuter et c'est mort
Pas étonnant qu'une fois sur deux ça coince et que ça plante

ShellExecuteEx est ton ami, aimes le, utilises le !

[ShaiLeTroll]

Sinon au lieu de détourner la sortie dans un fichier pourquoi ne pas la récupérer en temps réel : Redirection des entrées/sorties du process cela utilise CreateProcess et CreatePipe
Cela gère les paramètres

Code :

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

1
2
3
4
5
6
7
8
9
 
//------------------------------------------------------------------------------
class function TxxxModuleAutomateLogistique.GetPingString(const AModuleHost: string): string;
var
  ExitCode: Int64;
  ErrorText: string;
begin
  TSLTShellExecuteWrapper.CallCmd('', 'ping.exe', AModuleHost, ExitCode, Result, ErrorText);
end;

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
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
{* -----------------------------------------------------------------------------
la fonction CallCmd permet de lancer un programme console, tout en récupérant en quasi temps-réel le contenu devant normalement s'y afficher
@param CmdDirectory Dossier contenant le Fichier CmdName
@param CmdName programme console à executer
@param CmdParam paramètres de la ligne de commande
@param ExitCode Code de Sortie renvoyé par le programme console, -1 si non récupéré
@param OutputText chaine contenant tout ce qui aurait du s'afficher (canal sortie)
@param ErrorText chaine contenant tout ce qui a été signalé comme erreurs (canal erreur)
@param Delay indique le temps entre chaque cycle de lecture des canaux, détermine la fréquence de lancement de WaitEvent, par défaut, cela attend que le programme console se termine
@param WaitEvent procédure à lancer lorsque le Delay est écoulé, Output et Error contiennent les derniers éléments envoyés par le programme console sur les canaux depuis le dernier délai, AbortProcess indique si la processus doit être arrêté
@param PipeMaxSize défini la taille maximal que l'on lit à chaque chaque cycle de lecture des canaux, si zéro, taille non limitée par défaut
@return Indique si le programme a été lancé
------------------------------------------------------------------------------ }
class function TSLTShellExecuteWrapper.CallCmd(const CmdDirectory, CmdName, CmdParam: string; out ExitCode: Int64; out OutputText: string; out ErrorText: string; Delay: Cardinal = INFINITE; WaitEvent: TSLTShellExecuteWrapperCallCmdEvent = nil; PipeMaxSize: Cardinal = 0): Boolean;
var
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
  CmdLine: string; // utile pour le débogage
  SecurityAttr : TSecurityAttributes;
  hReadPipeInput, hWritePipeInput: NativeUInt;
  hReadPipeOutput, hWritePipeOutput: NativeUInt;
  hReadPipeError, hWritePipeError: NativeUInt;
  lpCurrentDirectory: PChar;
  Terminated: Boolean;
  AbortProcess: Boolean;
  HandleFunctionProcess: Cardinal;
 
  function ReadPipe(Handle: Cardinal; out Buf: string): Boolean;
  const
    MAX_INT: Cardinal = MaxInt;
  var
    PipeSize: Cardinal;
    PipeToRead, PipeReaded: Cardinal;
    PipeBuf: array of AnsiChar;
    AnsiBuf: AnsiString;
  begin
    PipeSize := GetFileSize(Handle, nil); // On oublie si cela dépasse 2Go ... normalement c'est 4Ko
    if (PipeMaxSize > 0) and (PipeSize > PipeMaxSize) then
      PipeToRead := PipeMaxSize
    else
      PipeToRead := PipeSize;
 
    Result := PipeToRead > 0;
    if Result then
    begin
      SetLength(PipeBuf, PipeToRead);
      ZeroMemory(@PipeBuf[0], PipeToRead);
      ReadFile(Handle, PipeBuf[0], PipeToRead, PipeReaded, nil);
 
      SetLength(AnsiBuf, PipeToRead);
      OemToAnsi(@PipeBuf[0], @AnsiBuf[1]);
      Buf := string(AnsiBuf);
    end;
  end;
 
  procedure ReadPipes();
  var
    DeltaOutputText: string;
    DeltaErrorText: string;
  begin
    if ReadPipe(hReadPipeOutput, DeltaOutputText) then
      OutputText := OutputText + DeltaOutputText;
    if ReadPipe(hReadPipeError, DeltaErrorText) then
      ErrorText := ErrorText + DeltaErrorText;
    try
      if Assigned(WaitEvent) then
        WaitEvent(DeltaOutputText, DeltaErrorText, AbortProcess);
    except
      on E: Exception do
        OutputDebugString(PChar(Format('s.CallCmd.ReadPipes.WaitEvent - "%s" : "%s"', [Self.ClassName(), E.ClassName(), E.Message])));
    end;
  end;
 
begin
  (*
  Result := True;
  OutputText := 'Dummy Output';
  ErrorText := 'Dummy Error';
  ErrorCode := 0;
  Exit;
  *)
  OutputText := '';
  ErrorText := '';
  try
    SecurityAttr.nLength := SizeOf(TSecurityAttributes);
    SecurityAttr.lpSecurityDescriptor := nil;
    SecurityAttr.bInheritHandle := True;
    if CreatePipe(hReadPipeInput, hWritePipeInput, @SecurityAttr, 0) and
      CreatePipe(hReadPipeOutput, hWritePipeOutput, @SecurityAttr, 0) and
      CreatePipe(hReadPipeError, hWritePipeError, @SecurityAttr, 0) then
    begin
      try
        ZeroMemory(@StartupInfo, SizeOf(StartupInfo)); // GetStartupInfo(StartupInfo);
        StartupInfo.cb := SizeOf(StartupInfo);
        StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES; // Active wShowWindow et hStdOutput/hStdError
        StartupInfo.wShowWindow := SW_HIDE;
        StartupInfo.hStdInput := hReadPipeInput;
        StartupInfo.hStdOutput := hWritePipeOutput;
        StartupInfo.hStdError := hWritePipeError;
        ZeroMemory(@ProcessInfo, SizeOf(ProcessInfo));
 
        if CmdDirectory <> '' then
        begin
          CmdLine := Format('"%s%s" %s', [IncludeTrailingPathDelimiter(CmdDirectory), CmdName, CmdParam]);
          lpCurrentDirectory := PChar(CmdDirectory);
        end
        else
        begin
          CmdLine := Format('%s %s', [CmdName, CmdParam]);
          lpCurrentDirectory := nil;
        end;
 
        Result := CreateProcess(nil, PChar(CmdLine), @SecurityAttr, @SecurityAttr, True, 0, nil, lpCurrentDirectory, StartupInfo, ProcessInfo);
        if Result then
        begin
          try
            Terminated := False;
            AbortProcess := False;
            while not Terminated do
            begin
              case WaitForSingleObject(ProcessInfo.hProcess, Delay) of
                WAIT_OBJECT_0 :
                  begin
                    ReadPipes();
                    Terminated := True;
                  end;
                WAIT_ABANDONED : Terminated := True;
                WAIT_TIMEOUT :
                  begin
                    ReadPipes();
                    Terminated := Delay = INFINITE;
                  end;
                WAIT_FAILED: Abort;
              else
                Terminated := True;
              end;
 
              if AbortProcess then
              begin
               HandleFunctionProcess := OpenProcess(PROCESS_TERMINATE, False, ProcessInfo.dwProcessId);
               if HandleFunctionProcess > 0 then
               begin
                 TerminateProcess(HandleFunctionProcess, 0);
                 CloseHandle(HandleFunctionProcess);
               end;
              end;
            end;
 
            TULargeInteger(ExitCode).HighPart := 0;
            if not GetExitCodeProcess(ProcessInfo.hProcess, TULargeInteger(ExitCode).LowPart) then
              ExitCode := -1;
          finally
            CloseHandle(ProcessInfo.hThread);
            CloseHandle(ProcessInfo.hProcess); // The handles for both the process and the main thread must be closed through calls to CloseHandle
          end;
        end;
      finally
        CloseHandle(hReadPipeInput);
        CloseHandle(hWritePipeInput);
        CloseHandle(hReadPipeOutput);
        CloseHandle(hWritePipeOutput);
        CloseHandle(hReadPipeError);
        CloseHandle(hWritePipeError);
      end;
    end
    else
      raise Exception.Create('Impossible de créer les Pipes');
  except
    on E: Exception do
    begin
      OutputDebugString(PChar(Format('%s.CallCmd Error %s, Message : %s', [Self.ClassName(), E.ClassName(), E.Message])));
      raise;
    end;
  end;
end;

[Roland Chastain]

Merci, ShaiLeTroll, pour la nouvelle version de cet excellent code.

Personnellement, j'aurais choisi un autre nom pour la variable CmdLine, afin d'éviter la confusion avec la variable du même nom déclarée dans l'unité System.

Autrement, j'ai une question : les chaînes passées à la procédure OutputDebugString(), où est-ce que tu les lis ?

[ShaiLeTroll]

Cela vient de CreateProcess est son paramètre lpCommandLine et que je l'ai à la base conçu que pour des BAT ou des programmes Consoles
Et je t'avoue ne pas connaitre la CmdLine de Delphi, je n'utilisais que ParamStr/ParamCount et depuis un bon paquet d'année je n'utilise plus que FindCmdLineSwitch
Faudrait effectivement que je l'a renommé en CommandLine



Et pour OutputDebugString uniquement en Debug depuis Delphi via CTRL + ALT + V - Fenêtre Journal d'événements