Delphi - TDosCommand 问题

Delphi - TDosCommand issue

我需要从 Delphi 调用批处理脚本。 我正在使用 TDosCommand,因为我想在外部进程完成之前显示来自批处理的回显消息。 如何在程序中等待脚本完成?

这是一个简单的演示示例。我在点击时调用 Test.bat。暂停仅用于测试目的。

Test.bat.

@echo off

echo Script start
echo First line 
ping 192.0.2.1 -n 1 -w 1000 >nul 
echo Second line  
ping 192.0.2.1 -n 1 -w 2000 >nul 
echo Third line
ping 192.0.2.1 -n 1 -w 3000 >nul 
echo Fourth line
ping 192.0.2.1 -n 1 -w 4000 >nul
echo Script end 

Pas文件。 Procedure ExecuteBatch 调用批处理脚本。 添加了 Application.ProcessMessages 的等待循环。那么有没有更好的解决方案呢Application.ProcessMessages?

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ComCtrls, DosCommand;

type
  TForm1 = class(TForm)
    RichEdit1: TRichEdit;
    btnExecuteBatch: TButton;
    procedure ExecuteBatch;
    procedure btnExecuteBatchClick(Sender: TObject);
    procedure DosCommand1NewLine(ASender: TObject; const ANewLine: string; AOutputType: TOutputType);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.ExecuteBatch;
var
  i: integer;
  DosCommand1: TDosCommand;
begin
  DosCommand1 := TDosCommand.Create(Self);
  DosCommand1.OnNewLine := DosCommand1NewLine;
  DosCommand1.CommandLine := '..\..\Test.bat';
  DosCommand1.Execute;

  repeat
    sleep(100);
    Application.ProcessMessages;
  until (DosCommand1.EndStatus <> esStill_Active);

  //here I need to wait until Test.bat script finishes
  // (repeat-until?)

  RichEdit1.Lines.Add('End of ExecuteBatch procedure.');

end;

procedure TForm1.DosCommand1NewLine(ASender: TObject; const ANewLine: string; AOutputType: TOutputType);
begin
  if AOutputType = otEntireLine then
  begin
    RichEdit1.Lines.Add(ANewLine);
  end;
end;

procedure TForm1.btnExecuteBatchClick(Sender: TObject);
begin
  RichEdit1.Clear;
  ExecuteBatch;
end;

end.

测试表格的dfm文件。我正在使用 RichEdit,因为我需要更改某些线条的颜色。

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 645
  ClientWidth = 924
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object RichEdit1: TRichEdit
    Left = 8
    Top = 8
    Width = 633
    Height = 629
    Font.Charset = EASTEUROPE_CHARSET
    Font.Color = clWindowText
    Font.Height = -11
    Font.Name = 'Tahoma'
    Font.Style = []
    Lines.Strings = (
      'RichEdit1')
    ParentFont = False
    TabOrder = 0
    Zoom = 100
  end
  object btnExecuteBatch: TButton
    Left = 696
    Top = 16
    Width = 113
    Height = 41
    Caption = 'Execute Batch'
    TabOrder = 1
    OnClick = btnExecuteBatchClick
  end
end

查看 TDosCommand source code,您有 3 种方法可以知道启动的进程是否为 运行:使用 属性 ExitCode,或 属性 EndStatus,或事件 OnTerminated.

使用 OnTerminated 事件可以避免构建等待循环,这通常不是一个好主意。

如果你想让你的代码尽可能接近原来的样子,你可以检查 IsRunning 属性。

while DosCommand1.IsRunning do
begin
    sleep(100);
    Application.ProcessMessages;
end;