نحوه گرفتن خروجی یک فایل Batch در دلفی

[yassabz]

سلام

دوستان من میخوام یک فایل batch رو با دلفی اجرا کرده و گزارش خروجیش رو با دلفی داخل برنامه از طریق یل memo یا ... داشته باشم .. از طریق shellexecute تونستم فایل رو اجرا کنم و گزارشش رو داخل یک فایل متنی داشته باشم و فایل متن رو داخل memo نمایش بدم .. اما عملا خوب جواب نمیده و خروجیش رو نمیتونم خوب داشته باشم .مخصوصا این که گاهی عملیات کار ما گاهی بیشتر یا کمتر طول میکشه ... کسی در این رابطه تجربه ای چیزی داره ؟! یا راه بهتری برای نمایش مستقیم خروجی batch فایل ؟؟! مرسی

[Felony]

این رو قبلا تو یک برنامه برای pipe زدن نوشته بودم ( البته قسمت هایی رو یادمه از یه سایت روسی پیدا کرده بودم و کاملش کردم ) :

// Run command and return result of it



type

  TArg<T> = reference to procedure(const Arg: T);



procedure CaptureConsoleOutput(const ACommand, AParameters: String;

  CallBack: TArg<PAnsiChar>);

const

  CReadBuffer = 2400;



var

  saSecurity: TSecurityAttributes;

  hRead: THandle;

  hWrite: THandle;

  suiStartup: TStartupInfo;

  piProcess: TProcessInformation;

  pBuffer: array [0 .. CReadBuffer] of AnsiChar;

  dBuffer: array [0 .. CReadBuffer] of AnsiChar;

  dRead: DWORD;

  dRunning: DWORD;

  dAvailable: DWORD;

begin

  saSecurity.nLength := SizeOf(TSecurityAttributes);

  saSecurity.bInheritHandle := True;

  saSecurity.lpSecurityDescriptor := nil;

  if CreatePipe(hRead, hWrite, @saSecurity, 0) then

    try

      FillChar(suiStartup, SizeOf(TStartupInfo), #0);

      suiStartup.cb := SizeOf(TStartupInfo);

      suiStartup.hStdInput := hRead;

      suiStartup.hStdOutput := hWrite;

      suiStartup.hStdError := hWrite;

      suiStartup.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;

      suiStartup.wShowWindow := SW_HIDE;

      if CreateProcess(nil, PChar(ACommand + ' ' + AParameters), @saSecurity,

        @saSecurity, True, NORMAL_PRIORITY_CLASS, nil, nil, suiStartup,

        piProcess) then

        try

          repeat

            dRunning := WaitForSingleObject(piProcess.hProcess, 100);

            PeekNamedPipe(hRead, nil, 0, nil, @dAvailable, nil);

            if (dAvailable > 0) then

              repeat

                dRead := 0;

                ReadFile(hRead, pBuffer[0], CReadBuffer, dRead, nil);

                pBuffer[dRead] := #0;

                OemToCharA(pBuffer, dBuffer);

                CallBack(dBuffer);

              until (dRead < CReadBuffer);

            Application.ProcessMessages;

          until (dRunning <> WAIT_TIMEOUT);

        finally

          CloseHandle(piProcess.hProcess);

          CloseHandle(piProcess.hThread);

        end;

    finally

      CloseHandle(hRead);

      CloseHandle(hWrite);

    end;

end;

نمونه استفاده :

      CaptureConsoleOutput

        ('cmd.exe', 'dir',

        procedure(const Line: PAnsiChar)

        begin

          Writeln(String(Line));

        end);

خودتون میتونید تغییرات مورد نیاز رو انجام بدید .

[yassabz]

سلام
ممنون از راهنمایی اما برای من خوب کار نکرد !!! احتمالا یه جای کار میلنگه ..

اینم نمونه برنامه ای ک توش به کار بردم : http://www.4shared.com/rar/XJ1X3Ut7/get_cmd.html

زحمتتون یه چک میکنین ؟ مرسی

[yassabz]

کجای کارم مشکل داره : به این صورت استفاده کردم !!!



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.Buttons, Vcl.ComCtrls;

type
TForm1 = class(TForm)
gtbtn: TBitBtn;
Memo1: TMemo;
BitBtn1: TBitBtn;
ProgressBar1: TProgressBar;
procedure gtbtnClick(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure ProgressBar1ContextPopup(Sender: TObject; MousePos: TPoint;
var Handled: Boolean);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

type
TArg<T> = reference to procedure(const Arg: T);

procedure CaptureConsoleOutput(const ACommand, AParameters: String;
CallBack: TArg<PAnsiChar>);
const
CReadBuffer = 2400;

var
saSecurity: TSecurityAttributes;
hRead: THandle;
hWrite: THandle;
suiStartup: TStartupInfo;
piProcess: TProcessInformation;
pBuffer: array [0 .. CReadBuffer] of AnsiChar;
dBuffer: array [0 .. CReadBuffer] of AnsiChar;
dRead: DWORD;
dRunning: DWORD;
dAvailable: DWORD;
begin
saSecurity.nLength := SizeOf(TSecurityAttributes);
saSecurity.bInheritHandle := True;
saSecurity.lpSecurityDescriptor := nil;
if CreatePipe(hRead, hWrite, @saSecurity, 0) then
try
FillChar(suiStartup, SizeOf(TStartupInfo), #0);
suiStartup.cb := SizeOf(TStartupInfo);
suiStartup.hStdInput := hRead;
suiStartup.hStdOutput := hWrite;
suiStartup.hStdError := hWrite;
suiStartup.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
suiStartup.wShowWindow := SW_HIDE;
if CreateProcess(nil, PChar(ACommand + ' ' + AParameters), @saSecurity,
@saSecurity, True, NORMAL_PRIORITY_CLASS, nil, nil, suiStartup,
piProcess) then
try
repeat
dRunning := WaitForSingleObject(piProcess.hProcess, 100);
PeekNamedPipe(hRead, nil, 0, nil, @dAvailable, nil);
if (dAvailable > 0) then
repeat
dRead := 0;
ReadFile(hRead, pBuffer[0], CReadBuffer, dRead, nil);
pBuffer[dRead] := #0;
OemToCharA(pBuffer, dBuffer);
CallBack(dBuffer);
until (dRead < CReadBuffer);
Application.ProcessMessages;
until (dRunning <> WAIT_TIMEOUT);
finally
CloseHandle(piProcess.hProcess);
CloseHandle(piProcess.hThread);
end;
finally
CloseHandle(hRead);
CloseHandle(hWrite);
end;
end;


procedure TForm1.gtbtnClick(Sender: TObject);
begin
CaptureConsoleOutput
('d:\cmd.exe ', ' dir c:\*.* ',procedure(const Line: PAnsiChar)
begin
// Writeln(String(Line));
Memo1.Lines.Add(String(Line)) ;
end);
end;

[yassabz]

دوستان از

OemToAnsi(Buffer,Buffer);

اشکال میگیره .. کسی میتونه راهنمایی کنه ؟؟؟ کارم گیرشه ..!!

[Mask]

دوست گرامی:
در ابتدا کدهات رو در بلوک کد سایت قرار بده . تا به صورت صحیح ببینیمشون.
وقتی خود شما برای سوالتون وقت صرف نمیکنید ، چطور انتظار دارید کاربران وقتی وارد این تاپیک میشوند و کدهای در هم شما رو بررسی کنند و به شما جواب بدهند.
و همچنین این سوال شما تا کنون چندین بار مطرح شده و به جواب رسیده. لطفا ، خواهشا ، حد اقل برای جلوگیری از بی نظمی بیشتر و یا سریعتر به جواب رسیدن سوالتون ، جستجو کنید.
لینکهای زیر در مورد سوال شما قبلا ایجاد شده:
https://barnamenevis.org/showthread.p...l=1#post799628

https://barnamenevis.org/showthread.p...=1#post1699075
و ...
اگر هم باز این لینکها بهتون کمک نکرد ، میتونید از این کد استفاده کنید:

function GetDosOutput(CommandLine: string; Work: string = 'C:\'): string;

var

  SA: TSecurityAttributes;

  SI: TStartupInfo;

  PI: TProcessInformation;

  StdOutPipeRead, StdOutPipeWrite: THandle;

  WasOK: Boolean;

  Buffer: array[0..255] of AnsiChar;

  BytesRead: Cardinal;

  WorkDir: string;

  Handle: Boolean;

begin

  Result := '';

  with SA do begin

    nLength := SizeOf(SA);

    bInheritHandle := True;

    lpSecurityDescriptor := nil;

  end;

  CreatePipe(StdOutPipeRead, StdOutPipeWrite, @SA, 0);

  try

    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 stdin

      hStdOutput := StdOutPipeWrite;

      hStdError := StdOutPipeWrite;

    end;

    WorkDir := Work;

    Handle := CreateProcess(nil, PChar('cmd.exe /C ' +'"'+CommandLine+'"'),

                            nil, nil, True, 0, nil,

                            PChar(WorkDir), SI, PI);

    CloseHandle(StdOutPipeWrite);

    if Handle then

      try

        repeat

          WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil);

          if BytesRead > 0 then

          begin

            Buffer[BytesRead] := #0;

            Result := Result + Buffer;

          end;

        until not WasOK or (BytesRead = 0);

        WaitForSingleObject(PI.hProcess, INFINITE);

      finally

        CloseHandle(PI.hThread);

        CloseHandle(PI.hProcess);

      end;

  finally

    CloseHandle(StdOutPipeRead);

  end;

end;

[yassabz]

ممنون .. عذر می خوام در رابطه با بلوک اطلاع نداشتم .. از لینک هایی که گذاشتین و استفاده کردم اما بازم تو این خط خطا میگیره :

   OemToAnsi(Buffer,Buffer);  

مشکل کجا میتونه باشه ؟


میشه یک مثال استفاده واسه کد بالا هم بزارید؟


مرسی

[yassabz]

از کدوم نسخه از دلفی استفاده میکنید.

از نسخه

Rad XE3

[yassabz]

چی شد ؟!! به چیزی بر خوردید ؟!!

[Mask]

من xe3 برای تست ندارم.
با xe تست کردم.مشکلی نداشت.

[yassabz]

من xe3 برای تست ندارم.
با xe تست کردم.مشکلی نداشت.

کدوم رو تست کردید ؟؟ واسه کدی که خودتون گذاشتید یک مورد نمونه دارید بزارید .. ممنون میشم

[BORHAN TEC]

سلام
بهترین و قابل اعتمادترین روشی که بعد از مدتها تحقیق در این رابطه توانستم پیدا کنم استفاده از کلاس TProcess در Lazarus بود و هیچ نمونه بهتری هم برای دلفی وجود ندارد. بهتره که در داخل Lazarus یک DLL برای این کار ایجاد کرده و از آن DLL در دلفی استفاده کنید. مطمئن باشید که نمونه بهتری را پیدا نخواهید کرد که در تمامی شرایط جوابگو باشد! این هم مستندات این کلاس:
http://wiki.freepascal.org/Executing_External_Programs
در هر صورت اگه یکی همت کنه و این کلاس رو به صورت کامل در دلفی پیاده سازی کنه خیلی ثواب میبره!
موفق باشید...

[yassabz]

ممنون .. امکانش هست اگه خودتون اینو تا حالا تست کردید یک سورس کد در این رابطه برام بزارید ؟؟ .. باور کنید الان 2 هفته هست درگیر این جریانم و جواب نمی گیرم .. خیلی ممنون میشم

[yassabz]

شما که اینو تست کردید اگه براتون امکانش هست سورس تونو برام بزارید .. من جواب نمی گیرم !!

[Mask]

از این سمپل استفاده کنید.

[yassabz]

از این سمپل استفاده کنید.

سلام
واقعا ممنون بابت نمونه ای که گذاشتید .. خیلی خوب بود ..اما از این طرق خروجی یک برنامه batch و یا اجرا کردن یکی ازپارامتر های یک برنامه کنسولی رو خیلی تست کردم نتونستم بگیرم !! فقط وارد پوشه یا گرفتن دایرکتری و .. و یا اجرا کردن برنامه ..اما بعد اجرا شدن برنامه نمیتونم پارامتر هاشو فراخونی کنم !! کجای کارم مشکل داره ؟؟؟

[Mask]

مثال بزنید.

[BORHAN TEC]

سلام
یک راه حل هم برای دلفی پیدا کردم. استفاده از کامپوننت TJvCreateProcess از مجموعه JVCL. البته هنوز به صورت کامل تستش نکردم که ببینیم از لحاظ پایداری و قابلیت به کلاس TProcess موجود در Lazarus میرسه یا نه.

[yassabz]

سلام .ممنون از هم فکریتون

ببینید یک برنامه کنسولی هست که یک سری دستورات داره و من یک برنامه دارم که توی یک قسمتش نیاز هست که بعضی از دستورات این برنامه فراخونی بشه و بعضی هاشو خروجی داشته باشم .. البته دیدم که بعضی ها تو برنامه هاشون این کارو کردن .!

[Mask]

خوب. یه مثالی. نمونه ای. چیزی.آخه ما که علم غیب نداریم ،
من از همین سمپل برای همه دستورات cmd بدون مشکل استفاده میکنم.

[BORHAN TEC]

سلام
کامپوننت TJvCreateProcess رو به صورت کامل تست کردم و جالبه که در تمامی شرایط (مثل Nested Pipes و ...) جوابگو است. به عنوان یک نمونه هم می تونید از مثالی که به همراه JVCL عرضه شده استفاده کنید(ConsoleExample.dpr). در ضمن به رویداد OnShow در فرم مربوط به این مثال بیشتر دقت کنید.
موفق باشید...