加载中…
个人资料
  • 博客等级:
  • 博客积分:
  • 博客访问:
  • 关注人气:
  • 获赠金笔:0支
  • 赠出金笔:0支
  • 荣誉徽章:
正文 字体大小:

如何用Delphi运行DOS命令,把结果显示在MEMO里【转】

(2010-07-30 06:00:08)
标签:

杂谈

分类: 临时【程序】
前几日遇到的问题在各位的帮助下已经圆满解决,现在吧这段代码写出来,可能会有一点用处。
procedure   CheckResult(b:   Boolean);
begin
    if   not   b   then
          Raise   Exception.Create(SysErrorMessage(GetLastError));
end;

function   RunDOS(const   Prog,   CommandLine,Dir:   String;var   ExitCode:DWORD):   String;
var
    HRead,HWrite:THandle;
    StartInfo:TStartupInfo;
    ProceInfo:TProcessInformation;
    b:Boolean;
    sa:TSecurityAttributes;
    inS:THandleStream;
    sRet:TStrings;
begin
    Result   :=   ' ';
    FillChar(sa,sizeof(sa),0);
    //设置允许继承,否则在NT和2000下无法取得输出结果
    sa.nLength   :=   sizeof(sa);
    sa.bInheritHandle   :=   True;
    sa.lpSecurityDescriptor   :=   nil;
    b   :=   CreatePipe(HRead,HWrite,@sa,0);
    CheckResult(b);

    FillChar(StartInfo,SizeOf(StartInfo),0);
    StartInfo.cb   :=   SizeOf(StartInfo);
    StartInfo.wShowWindow   :=   SW_HIDE;
    //使用指定的句柄作为标准输入输出的文件句柄,使用指定的显示方式
    StartInfo.dwFlags           :=   STARTF_USESTDHANDLES+STARTF_USESHOWWINDOW;
    StartInfo.hStdError       :=   HWrite;
    StartInfo.hStdInput       :=   GetStdHandle(STD_INPUT_HANDLE);//HRead;
    StartInfo.hStdOutput     :=   HWrite;

    b   :=   CreateProcess(PChar(Prog),//lpApplicationName:   PChar          
                  PChar(CommandLine),         //lpCommandLine:   PChar
                  nil,         //lpProcessAttributes:   PSecurityAttributes
                  nil,         //lpThreadAttributes:   PSecurityAttributes
                  True,         //bInheritHandles:   BOOL
                  CREATE_NEW_CONSOLE,
                  nil,                  
                  PChar(Dir),
                  StartInfo,
                  ProceInfo         );

    CheckResult(b);
    WaitForSingleObject(ProceInfo.hProcess,INFINITE);
    GetExitCodeProcess(ProceInfo.hProcess,ExitCode);

    inS   :=   THandleStream.Create(HRead);
    if   inS.Size> 0   then
    begin
        sRet   :=   TStringList.Create;
        sRet.LoadFromStream(inS);
        Result   :=   sRet.Text;
        sRet.Free;
    end;
    inS.Free;

    CloseHandle(HRead);
    CloseHandle(HWrite);
end;
*******************
function   GetDosOutput(const   CommandLine:string):   string;
    var
        SA:   TSecurityAttributes;
        SI:   TStartupInfo;
        PI:   TProcessInformation;
        StdOutPipeRead,   StdOutPipeWrite:   THandle;
        WasOK:   Boolean;
        Buffer:   array[0..255]   of   Char;
        BytesRead:   Cardinal;
        WorkDir,   Line:   String;
    begin
        Application.ProcessMessages;
        with   SA   do
        begin
            nLength   :=   SizeOf(SA);
            bInheritHandle   :=   True;
            lpSecurityDescriptor   :=   nil;
        end;
        //   create   pipe   for   standard   output   redirection
        CreatePipe(StdOutPipeRead,     //   read   handle
                              StdOutPipeWrite,   //   write   handle
                              @SA,                           //   security   attributes
                              0                                 //   number   of   bytes   reserved   for   pipe   -   0   default
                              );
        try
            //   Make   child   process   use   StdOutPipeWrite   as   standard   out,
            //   and   make   sure   it   does   not   show   on   screen.
            with   SI   do
            begin
                FillChar(SI,   SizeOf(SI),   0);
                cb   :=   SizeOf(SI);
                dwFlags   :=   STARTF_USESHOWWINDOW   or   STARTF_USESTDHANDLES;
                wShowWindow   :=   SW_HIDE;
                hStdInput   :=   GetStdHandle(STD_INPUT_HANDLE);   //   don 't   redirect   stdinput
                hStdOutput   :=   StdOutPipeWrite;
                hStdError   :=   StdOutPipeWrite;
            end;

            //   launch   the   command   line   compiler
            WorkDir   :=   ExtractFilePath(CommandLine);
            WasOK   :=   CreateProcess(nil,   PChar(CommandLine),   nil,   nil,   True,   0,   nil,
                                                          PChar(WorkDir),   SI,   PI);
   
            //   Now   that   the   handle   has   been   inherited,   close   write   to   be   safe.
            //   We   don 't   want   to   read   or   write   to   it   accidentally.
            CloseHandle(StdOutPipeWrite);
            //   if   process   could   be   created   then   handle   its   output
            if   not   WasOK   then
                raise   Exception.Create( 'Could   not   execute   command   line! ')
            else
                try
                    //   get   all   output   until   dos   app   finishes
                    Line   :=   ' ';
                    repeat
                        //   read   block   of   characters   (might   contain   carriage   returns   and   line   feeds)
                        WasOK   :=   ReadFile(StdOutPipeRead,   Buffer,   255,   BytesRead,   nil);

                        //   has   anything   been   read?
                        if   BytesRead   >   0   then
                        begin
                            //   finish   buffer   to   PChar
                            Buffer[BytesRead]   :=   #0;
                            //   combine   the   buffer   with   the   rest   of   the   last   run
                            Line   :=   Line   +   Buffer;
                        end;
                    until   not   WasOK   or   (BytesRead   =   0);
                    //   wait   for   console   app   to   finish   (should   be   already   at   this   point)
                    WaitForSingleObject(PI.hProcess,   INFINITE);
                finally
                    //   Close   all   remaining   handles
                    CloseHandle(PI.hThread);
                    CloseHandle(PI.hProcess);
                end;
        finally
                result:=Line;
                CloseHandle(StdOutPipeRead);
        end;
    end;
**************
unit   Unit1;

interface

uses
    Windows,   Messages,   SysUtils,   Classes,   Graphics,   Controls,   Forms,   Dialogs,
    StdCtrls;

type
    TForm1   =   class(TForm)
        Memo1:   TMemo;
        OpenDialog1:   TOpenDialog;
        btnRUn:   TButton;
        btnOpenFIle:   TButton;
        btnEditFile:   TButton;
        editfilename:   TEdit;
        procedure   btnOpenfileClick(Sender:   TObject);
        procedure   btnRunClick(Sender:   TObject);
    private
        {   Private   declarations   }
    public
        {   Public   declarations   }
    end;

var
    Form1:   TForm1;

implementation

{$R   *.DFM}

procedure   TForm1.btnOpenfileClick(Sender:   TObject);
begin
    if   opendialog1.Execute   then   editfilename.Text   :=   opendialog1.FileName;
end;

procedure   TForm1.btnRunClick(Sender:   TObject);
var
    hReadPipe,   hWritePipe:   THandle;
    si:   STARTUPINFO;
    lsa:   SECURITY_ATTRIBUTES;
    pi:   PROCESS_INFORMATION;
    mDosScreen:   string;
    cchReadBuffer:   DWORD;
    ph:   PChar;
    fname:   PChar;
    i,   j:   integer;
begin
    fname   :=   allocmem(255);
    ph   :=   AllocMem(5000);
    lsa.nLength   :=   sizeof(SECURITY_ATTRIBUTES);
    lsa.lpSecurityDescriptor   :=   nil;
    lsa.bInheritHandle   :=   True;

    if   CreatePipe(hReadPipe,   hWritePipe,   @lsa,   0)   =   false   then
    begin
        ShowMessage( 'Can   not   create   pipe! ');
        exit;
    end;
    fillchar(si,   sizeof(STARTUPINFO),   0);
    si.cb   :=   sizeof(STARTUPINFO);
    si.dwFlags   :=   (STARTF_USESTDHANDLES   or   STARTF_USESHOWWINDOW);
    si.wShowWindow   :=   SW_SHOW;
    si.hStdOutput   :=   hWritePipe;
    StrPCopy(fname,   EditFilename.text);
    if   CreateProcess(nil,   fname,   nil,   nil,   true,   0,   nil,   nil,   si,   pi)   =   False   then
    begin
        ShowMessage( 'can   not   create   process ');
        FreeMem(ph);
        FreeMem(fname);
        Exit;
    end;

    while   (true)   do
    begin
        if   not   PeekNamedPipe(hReadPipe,   ph,   1,   @cchReadBuffer,   nil,   nil)   then   break;
        if   cchReadBuffer   <>   0   then
        begin
            if   ReadFile(hReadPipe,   ph^,   4096,   cchReadBuffer,   nil)   =   false   then   break;
            ph[cchReadbuffer]   :=   chr(0);
            Memo1.Lines.Add(ph);
        end
        else   if   (WaitForSingleObject(pi.hProcess,   0)   =   WAIT_OBJECT_0)   then   break;
        Sleep(100);
    end;

    ph[cchReadBuffer]   :=   chr(0);
    Memo1.Lines.Add(ph);
    CloseHandle(hReadPipe);
    CloseHandle(pi.hThread);
    CloseHandle(pi.hProcess);
    CloseHandle(hWritePipe);
    FreeMem(ph);
    FreeMem(fname);
end;

end.

0

阅读 收藏 喜欢 打印举报/Report
  

新浪BLOG意见反馈留言板 欢迎批评指正

新浪简介 | About Sina | 广告服务 | 联系我们 | 招聘信息 | 网站律师 | SINA English | 产品答疑

新浪公司 版权所有