Текущий архив: 2008.02.10;
Скачать: CL | DM;

Вниз

Своё приложение вместо bat-файла- Возможно?   Найти похожие ветки 

← →
Kotov   (2008-01-13 11:41) [0]

Писал программу для резервного копирования данных. Код получается не малнький... И тут я вспомнил институт и такую функцию в bat-файлах как "xcopy"!!! Всего один ключик и копироваться будут только свежие файлы, во время копирования на экране появляются строчки с тем - что копируется, также просто использовать фильтр...
Вот подскажите, пожалуйста, - как бы организовать запуск таких команд (досовских) из своего приложения, причём хотелось бы использовать, например, memo в своём-же приложении, вместо выскакивающего чёрного экрана?! Это как-то возможно?

---

← →
Virgo_Style ©   (2008-01-13 11:47) [1]

Напоминает байку про мель и балластную цистерну... Если все, что надо, выполнит XCopy, то зачем нужна программа?

А по сути - ShellExecute для начала.

---

← →
Kotov   (2008-01-13 11:56) [2]

> Если все, что надо, выполнит XCopy, то зачем нужна программа?
Во-первых: из-за тех-же самых ключей "XCopy" - продумать окно с чекбоксами (типа: v - копировать только изменённые файлы, v - заменять существующие... и т.п.). Во-вторых: "XCopy" - не единственная такая интересная функция! Можно на их основе ещё и простой архиватор организовать... и ещё много чего!!!

"ShellExecute"?! - не интересно! Я бы тогда и не спрашивал! Мне нужно именно: использовать, например, memo в своём-же приложении, вместо выскакивающего чёрного экрана. Вы ведь знаете, как боятся пользователи чего-то выскакивающего )))))! Закроют ещё ненароком! Плюс контролировать процесс хочется! Если использовать memo - потом это в log записать можно будет! а так ....

---

← →
Kolan ©   (2008-01-13 12:29) [3]

> использовать, например, memo в своём-же приложении, вместо
> выскакивающего чёрного экрана.

{************************************************************}
{                                                            }
{                       KRunApplication                      }
{                Copyright © 2007  KSoftWare               }
{                                                            }
{                                                            }
{  Разработчик: Товеровский Николай                          }
{  Модифицирован: 14 декабря 2007                            }
{                                                            }
{************************************************************}
unit KRunApplication;

interface
uses
 Windows, SysUtils, Forms;
type
 {ERunApplicationException — предок для всех исключений
   генерируемых в этом модуле.}
 ERunApplicationException = class(Exception);

 {IConsoleViewVisitor — интерфейс посетителя,
   умеющего отображать данные из консоли.}
 IConsoleViewVisitor = interface
   ["{F37E51D8-7E2A-4AC1-B090-8F38F860B48A}"]
   procedure ViewConsoleMessage(const Msg: string);
 end;

 {RunApplicationAndWaitTillFinish — функция для запуска процесса
 и ожидания его завершения.

 Для того, чтобы иметь возможность обработать полученные из консоли данные
 в процедуру надо передать объект, поддерживающий интерфейс IConsoleViewVisitor
 (паттерн Visitor).

 *Не стоит использовать её в доп. потоках.
 *Не забывайте, что при реализации интерфейса производится подсчет ссылок
   и ваш объект может быть удален автоматически. Для предотвращения такого
   поведения можно унаследовать класс от TInterfacedPersistent, или реализовать
   нужную функциональность вручную.}
 procedure RunApplicationAndWaitTillFinish(RunString: string;
   ConsoleViewVisitor: IConsoleViewVisitor = nil);
implementation  

procedure RunApplicationAndWaitTillFinish(RunString: string;
   ConsoleViewVisitor: IConsoleViewVisitor);
var
 StartupInfo: TStartupInfo;
 SecurityAttributes: TSecurityAttributes;
 ProcessInfo: TProcessInformation;
 StdOutPipeRead, StdOutPipeWrite: THandle;
 CreateResult: Boolean;
 S: string;
 BytesReadFromFile: Cardinal;
 BytesReadFromPipe: Cardinal;
 WaitResult: Cardinal;
begin
 with SecurityAttributes do
 begin
   nLength := SizeOf(SecurityAttributes);
   bInheritHandle := True;
   lpSecurityDescriptor := nil;
 end;
 
 {Создать пайп для перенаправления стандартного вывода.}
 if not CreatePipe(
   StdOutPipeRead, // дескриптор чтения.
   StdOutPipeWrite, // дескриптор записи.
   @SecurityAttributes, // аттрибуты безопасности.
   0) // количество байт принятых для пайпа — 0 по умолчанию.
 then
   raise ERunApplicationException.Create(SysErrorMessage(GetLastError));
 try
 
   with StartupInfo do
   begin
     FillChar(StartupInfo, SizeOf(StartupInfo), 0);
     cb := SizeOf(StartupInfo);
     dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
     wShowWindow := SW_HIDE;
     hStdInput := GetStdHandle(STD_INPUT_HANDLE); // стандартный ввод не перенаправляем
     hStdOutput := StdOutPipeWrite;
     hStdError := StdOutPipeWrite;
   end;

   ZeroMemory(@ProcessInfo, SizeOf(@ProcessInfo));

   CreateResult := CreateProcess(nil, PAnsiChar(RunString), nil, nil, True,
     0, nil, nil, StartupInfo, ProcessInfo);

   if CreateResult then
   begin
     try
       repeat
         Application.ProcessMessages;
         {Ждать процесс 100 мс.}
         WaitResult := WaitForSingleObject(ProcessInfo.hProcess, 100);
         Application.ProcessMessages;
         {Узнать сколько в пайпе байт}
         PeekNamedPipe(StdOutPipeRead, nil, 0, nil, @BytesReadFromPipe, nil);
         {Есл байт больше 0&#133}
         if BytesReadFromPipe > 0 then
         begin
           {&#133 выделить память для строки.}
           SetLength(S, BytesReadFromPipe);
           {Прочесть байты.}
           if not ReadFile(StdOutPipeRead, PChar(S)^, BytesReadFromPipe, BytesReadFromFile, nil) then
             raise ERunApplicationException.Create(SysErrorMessage(GetLastError));
           {Отрезать лишние.}
           SetLength(S, BytesReadFromFile);
           {Перекодировать из дос кодировки.}
           OemToAnsi(PChar(S), PChar(S));
           {Отправить полученые из консоли данные посетителю.}
           if Assigned(ConsoleViewVisitor) then
             ConsoleViewVisitor.ViewConsoleMessage(S);
         end;
       {Выйти если процесс завершился и нечего читать.}
       until (WaitResult <> WAIT_TIMEOUT) and (BytesReadFromPipe = 0);
     finally
       {Закрыть хендлы процесса.}
       CloseHandle(ProcessInfo.hThread);
       CloseHandle(ProcessInfo.hProcess);
     end;
   end
   else
     raise ERunApplicationException.Create(SysErrorMessage(GetLastError));
 finally
   {Закрыть хендлы пайпа.}
   CloseHandle(StdOutPipeRead);
   CloseHandle(StdOutPipeWrite);
 end;
end;

end.

---

← →
Kolan ©   (2008-01-13 12:31) [4]

Как пользоваться думаю понятно. Подписать на итерфейс можешь форму&#133

---

← →
Kotov   (2008-01-13 12:36) [5]

Спасибо, Kolan!
Поясни только, пожалуйста, пару моментов:

procedure RunApplicationAndWaitTillFinish(RunString: string;
  ConsoleViewVisitor: IConsoleViewVisitor);

1. RunString - функция вместе с ключами (через пробел)?
2. ConsoleViewVisitor - как связать это с Memo? или оно вообще для другово? тогда как?

---

← →
Kotov   (2008-01-13 12:45) [6]

И вижу:
Application.ProcessMessages;
значит данные о выполнении функции можно будет получать динамично ))))

---

← →
Kolan ©   (2008-01-13 12:50) [7]

> 1. RunString — функция вместе с ключами (через пробел)?

Да.

> 2. ConsoleViewVisitor — как связать это с Memo? или оно
> вообще для другово? тогда как?

Берещь свою форму:
TMainForm = class(TForm)

Реализуешь интерфейс:
TMainForm = class(TForm, IConsoleViewVisitor)
&#133
pubic
 procedure ViewConsoleMessage(const Msg: string);
end;

&#133

procedure TMainForm.ViewConsoleMessage(const Msg: string);
begin
 Memo1.Lines.Add(Msg);
end;

А запускать так:
RunApplicationAndWaitTillFinish("cmd.exe", Self)
Где Slef это ссылка на твою форму, которая и реализует нужный интерфейс.

---

← →
Kotov   (2008-01-13 13:00) [8]

Ещё раз, спасибо!
Теперь всё встало на свои места! ))))

P.S. На всякий случай - DOS окно открываться во время выполнения не будет?

---

← →
Kolan ©   (2008-01-13 13:02) [9]

> На всякий случай — DOS окно открываться во время выполнения
> не будет?

Нет.

---

← →
Dmitry S ©   (2008-01-13 19:07) [10]

2 вопроса по коду:
1. Можно ли его стартануть в потоке и убрать Application.ProcessMessages
2. Вместо WaitResult := WaitForSingleObject(ProcessInfo.hProcess, 100); как нибудь поставить ожидание данных из пайпа?

---

← →
Kolan ©   (2008-01-14 00:10) [11]

> 1. Можно ли его стартануть в потоке и убрать Application.ProcessMessages

Можно, надо код изменить&#133
Хотелось бы это сделать, но руки не доходят. Мож допишеш?


> 2. Вместо WaitResult := WaitForSingleObject(ProcessInfo.hProcess,
> 100); как нибудь поставить ожидание данных из пайпа?

Да хрень какая-то, но это все что я смог сделать по найденным примерам. Пробовал по аналогии с COM портом сделать аснхроный режим, но не получилось ничего&#133

---

← →
Kolan ©   (2008-01-14 00:10) [12]

> 1. Можно ли его стартануть в потоке и убрать Application.ProcessMessages

Можно, надо код изменить&#133
Хотелось бы это сделать, но руки не доходят. Мож допишеш?


> 2. Вместо WaitResult := WaitForSingleObject(ProcessInfo.hProcess,
> 100); как нибудь поставить ожидание данных из пайпа?

Да хрень какая-то, но это все что я смог сделать по найденным примерам. Пробовал по аналогии с COM портом сделать аснхроный режим, но не получилось ничего&#133

---

← →
Dmitry S ©   (2008-01-14 02:03) [13]

type
 TProcessProcParam =
 record
   ApplicationName: PChar;
   CommandLine: PChar;
   DataProc: procedure (Str:PChar);
 end;
 PProcessProcParam = ^TProcessProcParam;

function ProcessProc(P:PProcessProcParam):DWord; stdcall;
var
 StartupInfo: TStartupInfo;
 ProcessInfo: TProcessInformation;
 SecurityAttributes: TSecurityAttributes;
 StdOutPipeRead, StdOutPipeWrite: THandle;
 CreateResult: Boolean;
 Chars: PChar;
 BytesReadFromFile: Cardinal;
 BytesReadFromPipe: Cardinal;
 WaitResult: Cardinal;
begin
 with SecurityAttributes do
 begin
   nLength := SizeOf(SecurityAttributes);
   bInheritHandle := True;
   lpSecurityDescriptor := nil;
 end;

 CreateResult := CreatePipe(StdOutPipeRead, StdOutPipeWrite, @SecurityAttributes, 0);
 if not CreateResult then
 begin
   P^.DataProc(nil);
   if assigned(P^.ApplicationName) then FreeMem(P^.ApplicationName);
   if assigned(P^.CommandLine) then FreeMem(P^.CommandLine);
   Dispose(P);
   Result := 1;
   Exit;
 end;

 with StartupInfo do
 begin
   FillChar(StartupInfo, SizeOf(StartupInfo), 0);
   cb := SizeOf(StartupInfo);
   dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
   wShowWindow := SW_HIDE;
   hStdInput := 0;//StdOutPipeRead2;//GetStdHandle(STD_INPUT_HANDLE);
   hStdOutput := StdOutPipeWrite;
   hStdError := StdOutPipeWrite;
 end;

 ZeroMemory(@ProcessInfo, SizeOf(@ProcessInfo));

 CreateResult := CreateProcess(P^.ApplicationName, P^.CommandLine, nil, nil,
   True, 0, nil, nil, StartupInfo, ProcessInfo);

 if not CreateResult then
 begin
   P^.DataProc(nil);
   CloseHandle(StdOutPipeRead);
   CloseHandle(StdOutPipeWrite);
   if assigned(P^.ApplicationName) then FreeMem(P^.ApplicationName);
   if assigned(P^.CommandLine) then FreeMem(P^.CommandLine);
   Dispose(P);
   Result := 2;
   Exit;
 end;

 repeat
   WaitResult := WaitForSingleObject(ProcessInfo.hProcess, 100);
   PeekNamedPipe(StdOutPipeRead, nil, 0, nil, @BytesReadFromPipe, nil);
   if BytesReadFromPipe > 0 then
   begin
     getMem(Chars, BytesReadFromPipe + 2);
     ZeroMemory(Chars, BytesReadFromPipe + 2);

     ReadFile(StdOutPipeRead, Chars^, BytesReadFromPipe, BytesReadFromFile, nil);
     OemToAnsi(Chars, Chars);
     P^.DataProc(Chars);

     FreeMem(Chars);
   end;
 until (WaitResult <> WAIT_TIMEOUT) and (BytesReadFromPipe = 0);

 P^.DataProc(nil);

 CloseHandle(ProcessInfo.hThread);
 CloseHandle(ProcessInfo.hProcess);

 CloseHandle(StdOutPipeRead);
 CloseHandle(StdOutPipeWrite);

 if assigned(P^.ApplicationName) then FreeMem(P^.ApplicationName);
 if assigned(P^.CommandLine) then FreeMem(P^.CommandLine);
 Dispose(P);

 Result := 0;
end;

procedure GoProcess(P:TProcessProcParam);
var
 PP:PProcessProcParam;
 C:DWord;
begin
 New(PP);
 if assigned(P.ApplicationName) then
 begin
   GetMem(PP^.ApplicationName, Length(P.ApplicationName));
   StrCopy(PP^.ApplicationName, P.ApplicationName);
 end
 else
 begin
   PP^.ApplicationName := nil;
 end;
 if assigned(P.CommandLine) then
 begin
   GetMem(PP^.CommandLine, Length(P.CommandLine));
   StrCopy(PP^.CommandLine, P.CommandLine);
 end
 else
 begin
   PP^.CommandLine := nil;
 end;
 PP^.DataProc := P.DataProc;
 // PP will free in thread
 CreateThread(nil, 0, @ProcessProc, PP, 0, C);
end;

procedure AddToFormMemo(Str:PChar);
begin
 // тут по идее синхронизация нужна, но лень искать где у Application его критическая секция
 if assigned(Str) then
   Form1.Memo1.Lines.Add(Str)
 else
   Form1.Memo1.Lines.Add("--- End ---");
end;

procedure TForm1.Button1Click(Sender: TObject);
var
 P:TProcessProcParam;
begin
 P.ApplicationName := nil;
 P.CommandLine := "cmd.exe";
 P.DataProc := AddToFormMemo;
 GoProcess(P);
end;

---

← →
Kotov   (2008-01-14 09:48) [14]

Супер! Спасибо Dmitry! Спасибо Kolan!

---

Страницы: 1 вся ветка

Текущий архив: 2008.02.10;
Скачать: CL | DM;

Наверх

Память: 0.53 MB
Время: 0.023 c