cmd окно через Exec и WinExec

[spirit-ua]

Всем Привет!

нашел исходник

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    lbl1: TLabel;
    lbl2: TLabel;
    btn1: TButton;
    btn2: TButton;
    edt1: TEdit;
    mmo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

type // Тип матриц перекодировки
  TCodeMatrix = array[1..255] of char;
const // Матрицы перекодировки
  FirstCodes =
    #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' !"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^' +
    '_`abcdefghijklmnopqrstuvwxyz{|}~';
  cmAnsiToKoi8R: TCodeMatrix = FirstCodes // ver 1.0, ©VEG, 31.10.2003
  + 'ЂЃ‚ѓ„…†‡€‰Љ‹ЊЌЋЏђ‘’“”•–—˜™љ›њќћџ ЎўЈ¤Ґ¦§Ё©Є«¬*®Ї°±Ііґµ¶·Ј—є»јЅѕїбвчздецъй'
    + 'клмнопртуфхжигюыэящшьасБВЧЗДЕЦЪЙКЛМНОПРТУФХЖИГЮЫЭЯЩШЬАС';
  cmOemDosToAnsi: TCodeMatrix = FirstCodes // ver 1.0, ©VEG, 31.10.2003
  + 'АБВГДЕЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯабвгдежзийклмноп---¦+¦¦¬¬¦¦¬---¬L+T+-+¦¦L'
    + 'г¦T¦=+¦¦TTLL-г++----¦¦-рстуфхцчшщъыьэюяЁёЄєЇїЎў°•·v№¤¦ ';
  cmIsoToAnsi: TCodeMatrix = FirstCodes // ver 1.0, ©VEG, 31.10.2003
  + '????????????????????????˜??????? ЁЂЃЄЅІЇЈЉЊЋЌ*ЎЏАБВГДЕЖЗИЙКЛМНОПРСТУФХЦЧШ'
    + 'ЩЪЫЬЭЮЯабвгдежзийклмнопрстуфхцчшщъыьэюя№ёђѓєѕіїјљњћќ§ўџ';

var
  Form1: TForm1;

implementation

{$R *.dfm}

Procedure SaveLog(Text1: AnsiString);
var
  f: TextFile;       // файл
  fName: String[80]; // имя файла
  strDate: string;
  y, m, d, h, i, s, ms: word;
begin
   decodeDate(now, y, m, d);
   decodeTime(now, h, i, s, ms);

   StrDate:=IntToStr(y)+'-';
   if m < 10 then
   StrDate:=StrDate+'0'+IntToStr(m)+'-'
   else
   StrDate:=StrDate+IntToStr(m)+'-';

   if d < 10 then
   StrDate:=StrDate+'0'+IntToStr(d)+' '
   else
   StrDate:=StrDate+IntToStr(d)+' ';

   if h < 10 then
   StrDate:=StrDate+'0'+IntToStr(h)+':'
   else
   StrDate:=StrDate+IntToStr(h)+':';

   if i < 10 then
   StrDate:=StrDate+'0'+IntToStr(i)+':'
   else
   StrDate:=StrDate+IntToStr(i)+':';

   if s < 10 then
   StrDate:=StrDate+'0'+IntToStr(s)+' - ('+IntToStr(ms)+')'
   else
   StrDate:=StrDate+IntToStr(s)+' - ('+IntToStr(ms)+')';

   fName := 'history.txt';
   AssignFile(f, fName);

   If FileExists(fName) = False Then// Если файл не существует
   Rewrite(f)  // Открыть для перезаписи
   Else Append(f);  // открыть для добавления

	 WriteLn(f, '------------------------');
   WriteLn(f, '   ' + StrDate);
   WriteLn(f, '   ' + text1);

   CloseFile(f); // закрыть файл

end;

function ConvertEncoding(sIn: string; sCoding: string): string;
//sIn - строка для перекодирования
//sCoding - матрица для перекодирования
//result - полученная перекодированная строка
var
  iFtd: integer;
begin
  for iFtd := 1 to length(sIn) do
    result := result + sCoding[ord(sIn[iFtd])];
end;

Function ShellExec(Commands: AnsiString): String;
var
   WshShell, Resc: Variant;
begin
   WshShell:=createOLEObject('WScript.Shell');
   Resc:=WshShell.Exec(commands);
   result:=Resc.StdOut.ReadAll;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
// create form

end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
// close form
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
// button1
   Edt1.Text := 'net view';
   SaveLog(Edt1.Text);
   Mmo1.Text:=ConvertEncoding(ShellExec(Edt1.Text), cmoemdostoansi);
   SaveLog(Mmo1.Text);
   Mmo1.setFocus;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
// button2
 	Close();
 	Application.Terminate();
end;

end.

все работает красиво но хотелось бы скрыть "досовое" окно, пробовал менять

Resc:=WshShell.Exec(commands);

на

Resc:=WshShell.WinExec(commands, SW_HIDE);

вываливает ошибку

   WshShell:=createOLEObject('WScript.Shell');
   Resc:=WshShell.Exec(commands);
   result:=Resc.StdOut.ReadAll;

ничего не смыслю кроме команды Exec... приблизительно понимаю что создается объект, запускается команда на выполнение и в result пишется результат, но...

помогите

[Stilet]

вываливает ошибку

Текст ошибки засекречен полицией нравов?

[spirit-ua]

Сообщение от Stilet

Текст ошибки засекречен полицией нравов?

вот скрин:

[Stilet]

Значит его можно только в скриптах юзать, если он есть.
Еще вопрос. А почему не хочешь воспользоваться таким вот способом: http://www.programmersforum.ru/showthread.php?t=108745
?
Я им раньше пользовался частенько.

[spirit-ua]

Сообщение от Stilet

Значит его можно только в скриптах юзать, если он есть.
Еще вопрос. А почему не хочешь воспользоваться таким вот способом: http://www.programmersforum.ru/showthread.php?t=108745
?
Я им раньше пользовался частенько.

попробовал, все норм, код

...
type // Тип матриц перекодировки
  TCodeMatrix = array[1..255] of char;
const // Матрицы перекодировки
  FirstCodes =
    #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' !"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^' +
    '_`abcdefghijklmnopqrstuvwxyz{|}~';
  cmOemDosToAnsi: TCodeMatrix = FirstCodes // ver 1.0, ©VEG, 31.10.2003
  + 'АБВГДЕЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯабвгдежзийклмноп---¦+¦¦¬¬¦¦¬---¬L+T+-+¦¦L'
    + 'г¦T¦=+¦¦TTLL-г++----¦¦-рстуфхцчшщъыьэюяЁёЄєЇїЎў°•·v№¤¦ ';
  cmIsoToAnsi: TCodeMatrix = FirstCodes // ver 1.0, ©VEG, 31.10.2003
  + '???????????????????????????????? ЁЂЃЄЅІЇЈЉЊЋЌ*ЎЏАБВГДЕЖЗИЙКЛМНОПРСТУФХЦЧШ'
    + 'ЩЪЫЬЭЮЯабвгдежзийклмнопрстуфхцчшщъыьэюя№ёђѓєѕіїјљњћќ§ўџ';
...
function ConvertEncoding(sIn: string; sCoding: string): string;
//sIn - строка для перекодирования
//sCoding - матрица для перекодирования
//result - полученная перекодированная строка
var
  iFtd: integer;
begin
  for iFtd := 1 to length(sIn) do
    result := result + sCoding[ord(sIn[iFtd])];
end;

procedure ExecConsoleApp(CommandLine: AnsiString; Output: TStringList; Errors:
  TStringList);
var
  sa: TSECURITYATTRIBUTES;
  si: TSTARTUPINFO;
  pi: TPROCESSINFORMATION;
  hPipeOutputRead: THANDLE;
  hPipeOutputWrite: THANDLE;
  hPipeErrorsRead: THANDLE;
  hPipeErrorsWrite: THANDLE;
  Res, bTest: Boolean;
  env: array[0..MAX_PATH] of Char;
  szBuffer: array[0..MAX_PATH] of Char;
  dwNumberOfBytesRead: DWORD;
  Stream: TMemoryStream;
begin
  sa.nLength := sizeof(sa);
  sa.bInheritHandle := true;
  sa.lpSecurityDescriptor := nil;
  CreatePipe(hPipeOutputRead, hPipeOutputWrite, @sa, 0);
  CreatePipe(hPipeErrorsRead, hPipeErrorsWrite, @sa, 0);
  ZeroMemory(@env, SizeOf(env));
  ZeroMemory(@si, SizeOf(si));
  ZeroMemory(@pi, SizeOf(pi));
  si.cb := SizeOf(si);
  si.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
  si.wShowWindow := SW_HIDE;
  si.hStdInput := 0;
  si.hStdOutput := hPipeOutputWrite;
  si.hStdError := hPipeErrorsWrite;

  (* Remember that if you want to execute an app with no parameters you nil the
     second parameter and use the first, you can also leave it as is with no
     problems.                                                                 *)
  Res := CreateProcess(nil, pchar(CommandLine), nil, nil, true,
    CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, @env, nil, si, pi);

  // Procedure will exit if CreateProcess fail
  if not Res then
  begin
    CloseHandle(hPipeOutputRead);
    CloseHandle(hPipeOutputWrite);
    CloseHandle(hPipeErrorsRead);
    CloseHandle(hPipeErrorsWrite);
    Exit;
  end;
  CloseHandle(hPipeOutputWrite);
  CloseHandle(hPipeErrorsWrite);

  //Read output pipe
  Stream := TMemoryStream.Create;
  try
    while true do
    begin
      bTest := ReadFile(hPipeOutputRead, szBuffer, 256, dwNumberOfBytesRead,
        nil);
      if not bTest then
      begin
        break;
      end;
      Stream.Write(szBuffer, dwNumberOfBytesRead);
    end;
    Stream.Position := 0;
    Output.LoadFromStream(Stream);
  finally
    Stream.Free;
  end;

  //Read error pipe
  Stream := TMemoryStream.Create;
  try
    while true do
    begin
      bTest := ReadFile(hPipeErrorsRead, szBuffer, 256, dwNumberOfBytesRead,
        nil);
      if not bTest then
      begin
        break;
      end;
      Stream.Write(szBuffer, dwNumberOfBytesRead);
    end;
    Stream.Position := 0;
    Errors.LoadFromStream(Stream);
  finally
    Stream.Free;
  end;

  WaitForSingleObject(pi.hProcess, INFINITE);
  CloseHandle(pi.hProcess);
  CloseHandle(hPipeOutputRead);
  CloseHandle(hPipeErrorsRead);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
OutP, ErrorP : TStringList;
begin
OutP := TStringList.Create;
  ErrorP := TstringList.Create;

  ExecConsoleApp('ping 192.168.1.1', OutP, ErrorP);

  Memo1.Text := ConvertEncoding(OutP.Text, cmoemdostoansi);
  Memo2.Text := ConvertEncoding(ErrorP.Text, cmoemdostoansi);

  OutP.Free;
  ErrorP.Free;
end;

но смущает что нету адреса, почему?

[Stilet]

А Х его З...
Я так не скажу... ConvertEncoding если убрать тоже не будет?

[spirit-ua]

Сообщение от Stilet

А Х его З...
Я так не скажу... ConvertEncoding если убрать тоже не будет?

если убрать тоже самое (нету адреса) + вместо кириллицы "кряказяблы"

[Stilet]

Ну тут я тебе не отвечу пожалуй...

[ДралсяСошибками]

Res := CreateProcess(nil, pchar(CommandLine), nil, nil, true,
CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, nil, nil, si, pi);

[spirit-ua]

Сообщение от ДралсяСошибками

Res := CreateProcess(nil, pchar(CommandLine), nil, nil, true,
CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, nil, nil, si, pi);

я так понимаю это к ПЕРВОМУ исходнику (который в первом посте), верно?