Delphi ile cmd komut göndermek ve yanıt almak

[Cyb3r]

(25-03-2017, Saat: 14:39)QuAdR Adlı Kullanıcıdan Alıntı: Güncel...

Teşekkür ederim

[Lord_Ares]

(18-09-2016, Saat: 00:18)QuAdR Adlı Kullanıcıdan Alıntı: Zamanın birinde değerli bir arkadaşım için yapmıştım böyle birşey.Ekte derlenmiş hali ve kodlarını bulabilirsiniz.

Delphi xe 10 berlin sürümünde derlemek istediğimde Aşağıdaki  gibi hata alıyorum. Sebebini anlamadım . 

[QuAdR]

@Lord_Ares
overload olarak iki defa tanımlanmış paremetre olarak compile edilirken ne olduğu belirtilmeli.
Aşağıdaki gibi düzeltirsen derleyecektir.
AOutput := AOutput + StrPas(PAnsiChar(vBuffer));

[Lord_Ares]

Delphi xe 10 ile denedim. Belli komutlar çalıştırabildim. Örneğin diskpart gibi yönetici hakları isteyen komutları malesef çalıştıramayıp program kırıldı. Teşekkürler

[yhackup]

(26-03-2017, Saat: 14:39)Lord_Ares Adlı Kullanıcıdan Alıntı: Delphi xe 10 ile denedim. Belli komutlar çalıştırabildim. Örneğin diskpart gibi yönetici hakları isteyen komutları malesef çalıştıramayıp program kırıldı. Teşekkürler

Uygulamayı yönetici olarak çalıştırmayı denediniz mi ?

[Lord_Ares]

Windoww 8 işletim sisteminde yönetici hakları ile belli başlı dos komutlarını denedim. ( Ver , Help gibi ) Program kilitleniyor. 

[AliZairov]

(26-03-2017, Saat: 02:44)QuAdR Adlı Kullanıcıdan Alıntı: Aşağıdaki gibi düzeltirsen derleyecektir.
AOutput := AOutput + StrPas(PAnsiChar(vBuffer));

Merhaba. Paylaşım için teşekkürler. Ben orjinal projeyi test etdim sorunsuz yukardakı düzeltmeden sonra çalıştı. Küçük bir projede kullanmak isteyince hata veriyor.

unit uConsole;

{
 Thanks: QuAdR
 http://www.delphican.com/uye-quadr.html
}

interface

uses
 Windows, SysUtils, StrUtils;

type
 TAnoPipe = record
   Input: THandle;
   Output: THandle;
 end;

function FastCapture(const ACmdLine: string): string;

implementation

function ExecAndCapture(const ACmdLine: string; var AOutput: string): Integer;
const
 cBufferSize = 2048;
var
 vBuffer: Pointer;
 vStartupInfo: TStartUpInfo;
 vSecurityAttributes: TSecurityAttributes;
 vReadBytes: DWord;
 vProcessInfo: TProcessInformation;
 vStdInPipe : TAnoPipe;
 vStdOutPipe: TAnoPipe;
begin
 Result := 0;

 with vSecurityAttributes do
 begin
   nlength := SizeOf(TSecurityAttributes);
   binherithandle := True;
   lpsecuritydescriptor := nil;
 end;

 if not CreatePipe(vStdInPipe.Output, vStdInPipe.Input, @vSecurityAttributes, 0) then
    raise Exception.Create('Pipe error: ' + SysErrorMessage(GetLastError));

 try
   if not CreatePipe(vStdOutPipe.Output, vStdOutPipe.Input, @vSecurityAttributes, 0) then
      raise Exception.Create('Pipe error: ' + SysErrorMessage(GetLastError));

   try
     GetMem(vBuffer, cBufferSize);
     try
       FillChar(vStartupInfo, Sizeof(TStartUpInfo), #0);
       vStartupInfo.cb         := SizeOf(TStartUpInfo);
       vStartupInfo.wShowWindow:= SW_HIDE;
       vStartupInfo.hStdInput  := vStdInPipe.Output;
       vStartupInfo.hStdOutput := vStdOutPipe.Input;
       vStartupInfo.dwFlags    := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;

       if not CreateProcess(nil
                            , PChar(ACmdLine)
                            , @vSecurityAttributes
                            , @vSecurityAttributes
                            , True
                            , NORMAL_PRIORITY_CLASS
                            , nil
                            , nil
                            , vStartupInfo
                            , vProcessInfo) then
         raise Exception.Create('Console error. System error msg: ' + SysErrorMessage(GetLastError));

       try
         while WaitForSingleObject(vProcessInfo.hProcess, 50) = WAIT_TIMEOUT do
           Sleep(0);

         AOutput := '';
         repeat
           ReadFile(vStdOutPipe.Output, vBuffer^, cBufferSize, vReadBytes, nil);
           if vReadBytes > 0 then
           begin
             //AOutput := AOutput + StrPas(vBuffer); // Delphi 7
             AOutput := AOutput + StrPas(PAnsiChar(vBuffer));
             Inc(Result, vReadBytes);
           end;
         until (vReadBytes < cBufferSize);
       finally
         CloseHandle(vProcessInfo.hProcess);
         CloseHandle(vProcessInfo.hThread);
       end;
     finally
       FreeMem(vBuffer);
     end;
   finally
     CloseHandle(vStdOutPipe.Input);
     CloseHandle(vStdOutPipe.Output);
   end;
 finally
   CloseHandle(vStdInPipe.Input);
   CloseHandle(vStdInPipe.Output);
 end;
end;

function FastCapture(const ACmdLine: string): string;
var
 vOutput: string;
begin
 ExecAndCapture(ACmdLine, vOutput);
 Result := Trim(AnsiReplaceStr(vOutput, #13#13#10, #13#10));
end;

end.

[QuAdR]

Konuyu yeni gördüm biraz zaman geçmiş ilgilenen arkadaşlar kusura bakmasın.
Nesneden yanıt gelmeyince sürekli döngüye giriyor ki bu yüzden process yanıt vermiyor.
Biraz değişiklik yaptım thread ekledim şimdi iyi çalışıyor.Aslında başlı başına thread içerisinde işletip sonlandırılan bir şeyler yapmak lazım.
Konuya ekliyorum.

[Bay_Y]

(25-03-2017, Saat: 14:39)QuAdR Adlı Kullanıcıdan Alıntı: Güncel...

Teşekkürler elinize sağlık.

---

(16-09-2016, Saat: 17:27)yhackup Adlı Kullanıcıdan Alıntı: Merhaba,

Nette rastladığım faydalı olabileceğini düşündüğüm bir fonksiyon...

function GetCommand(CommandLine: string): 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);
      hStdOutput := StdOutPipeWrite;
      hStdError := StdOutPipeWrite;
    end;
    WorkDir := GetCurrentDir;
    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;

paylaşım için teşekkürler.

[pro_imaj]

(16-09-2016, Saat: 17:27)yhackup Adlı Kullanıcıdan Alıntı: Merhaba,

Nette rastladığım faydalı olabileceğini düşündüğüm bir fonksiyon...

function GetCommand(CommandLine: string): 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);
      hStdOutput := StdOutPipeWrite;
      hStdError := StdOutPipeWrite;
    end;
    WorkDir := GetCurrentDir;
    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;

Merhaba,

CMD ile Linux SSH ile bağlanmaya çalışırken Normal CMD ekranında parola sorusu geliyor ve yazıp işleme devam edebiliyoruz, Yukarıdaki komutlarla işlem yaptığımızda Parola ekranı dönmediği için devam edemiyorum bunu deneyimleyen var mı acaba. 

Teşekkürler.