Server Ping per cmd

[mashutu]

Delphi-Quellcode:

function RunModulePiped(const sCommandLine : string; slStrings : TStrings):boolean;
type
    TCharBuffer = array[0..MaxInt - 1] of Char;
const
    MaxBufSize      = 1024;
var
    I               : Longword;
    SI              : TStartupInfo;
    PI              : TProcessInformation;
    _SA             : PSecurityAttributes;
    _pSD            : PSECURITY_DESCRIPTOR;
    NewStdIn        : THandle;
    NewStdOut       : THandle;
    ReadStdOut      : THandle;
    WriteStdIn      : THandle;
    Buffer          : ^TCharBuffer;
    BufferSize      : Cardinal;
    Last            : WideString;
    Str             : WideString;
    ExitCode        : DWORD;
    Bread           : DWORD;
    Avail           : DWORD;
begin
    result:=true;
    GetMem(_SA, SizeOf(TSecurityAttributes));
        case Win32Platform of
            VER_PLATFORM_WIN32_NT :
                begin
                    GetMem(_pSD, SizeOf(SECURITY_DESCRIPTOR));
                    SysUtils.Win32Check(InitializeSecurityDescriptor(_pSD, SECURITY_DESCRIPTOR_REVISION));
                    SysUtils.Win32Check(SetSecurityDescriptorDacl(_pSD, True, nil, False));
                    _SA.lpSecurityDescriptor := _pSD;
                end; {end VER_PLATFORM_WIN32_NT}
        else //case
            _SA.lpSecurityDescriptor := nil;
        end; {end case}
        _SA.nLength := SizeOf(SECURITY_ATTRIBUTES);
        _SA.bInheritHandle := True;

    SysUtils.Win32Check(CreatePipe(NewStdIn, WriteStdIn, _SA, 0));
    if not CreatePipe(ReadStdOut, NewStdOut, _SA, 0) then
    begin
        CloseHandle(NewStdIn);
        CloseHandle(WriteStdIn);
        RaiseLastWin32Error;
    end; {end if}
    GetStartupInfo(SI);
    SI.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
    SI.wShowWindow := {SW_SHOWNORMAL} SW_HIDE;
    SI.hStdOutput := NewStdOut;
    SI.hStdError := NewStdOut;
    SI.hStdInput := NewStdIn;
    if not CreateProcess(nil, PChar(sCommandLine), nil, nil, True,
                            CREATE_NEW_CONSOLE, nil, nil, SI, PI) then
    
    begin
        CloseHandle(NewStdIn);
        CloseHandle(NewStdOut);
        CloseHandle(ReadStdOut);
        CloseHandle(WriteStdIn);
        result:=false;
        //SysUtils.RaiseLastWin32Error;
        RaiseLastWin32Error;

    end; {end if}
    Last := '';
    BufferSize := MaxBufSize;
    Buffer := AllocMem(BufferSize);
    try
        repeat
            SysUtils.Win32Check(GetExitCodeProcess(PI.hProcess, ExitCode));
            PeekNamedPipe(ReadStdOut, Buffer, BufferSize, @Bread, @Avail, nil);
            if (Bread <> 0) then
            begin
                if (BufferSize < Avail) then
                begin
                    BufferSize := Avail;
                    ReallocMem(Buffer, BufferSize);
                end; {end if}
                FillChar(Buffer^, BufferSize, #0);
                ReadFile(ReadStdOut, Buffer^, BufferSize, Bread, nil);

                Str := Last;
                I := 0;
                while (I < Bread) do
                begin
                    case Buffer^[I] of
                        #0 : inc(I);
                        #10 :
                            begin
                                inc(I);
                                slStrings.Add(Str);
                                Str := '';
                            end; {end #10}
                        #13 :
                            begin
                                inc(I);
                                if (I < Bread) and (Buffer^[I] = #10) then
                                    inc(I);
                                slStrings.Add(Str);
                                Str := '';
                            end; {end #13}
                    else//case
                        begin
                            Str := Str + Buffer^[I];
                            inc(I);
                        end; {end else}
                    end; {end case}
                end; {end while}
                Last := Str;
            end; {end if}
            Sleep(1);
            Application.ProcessMessages;
        until (ExitCode <> STILL_ACTIVE);
        if Last <> '' then
            slStrings.Add(Last);
    finally
        FreeMem(Buffer);
    end; {end try/finally}
    CloseHandle(PI.hThread);
    CloseHandle(PI.hProcess);
    CloseHandle(NewStdIn);
    CloseHandle(NewStdOut);
    CloseHandle(ReadStdOut);
    CloseHandle(WriteStdIn);
    if _SA.lpSecurityDescriptor <> nil then
            freeMem(_pSD, SizeOf(SECURITY_DESCRIPTOR));
    
    freeMem(_SA, SizeOf(TSecurityAttributes));   //***hy freigeben des allozierten Speichers
end; {end procedure}