I'm using the code bellow to run a few "netsh wlan" commands in order to check wifi status, connect to a wifi profile, etc.
The problem that I'm having is that every now and then the app will hang on any of the commands, it's just a random thing, plus, sometimes the output returned get overwritten with "nothing", when I debugged it seemed like a timing issue.
I tried the conventional approach to run a command with Pascal but it didn't work with netsh, the approach is "cmd.exe /C netsh wlan....".
I appreciate any advise on getting this freezing procedure working better or another approach.
I'm running DelphiXE5.
Thanks
Sample commands: netsh wlan show profiles, netsh wlan show interfaces, etc.
procedure GetDosOutput(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;
begin
saSecurity.nLength := SizeOf(TSecurityAttributes);
saSecurity.bInheritHandle := True;
saSecurity.lpSecurityDescriptor := nil;
if CreatePipe(hRead, hWrite, @saSecurity, 0) then
begin
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
begin
repeat
dRunning := WaitForSingleObject(piProcess.hProcess, 100);
Application.ProcessMessages();
repeat
dRead := 0;
ReadFile(hRead, pBuffer[0], CReadBuffer, dRead, nil);
pBuffer[dRead] := #0;
//OemToAnsi(pBuffer, pBuffer);
//Unicode support by Lars Fosdal
OemToCharA(pBuffer, dBuffer);
CallBack(dBuffer);
until (dRead < CReadBuffer);
until (dRunning <> WAIT_TIMEOUT);
CloseHandle(piProcess.hProcess);
CloseHandle(piProcess.hThread);
end;
CloseHandle(hRead);
CloseHandle(hWrite);
end;
end;
After following all the advises I got this portion of code changed and so far the app hasn't hanged anymore.
Thanks a lot!
procedure GetDosOutput(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;
begin
saSecurity.nLength := SizeOf(TSecurityAttributes);
saSecurity.bInheritHandle := True;
saSecurity.lpSecurityDescriptor := nil;
if CreatePipe(hRead, hWrite, @saSecurity, 0) then
begin
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
begin
Application.ProcessMessages();
repeat
dRunning := WaitForSingleObject(piProcess.hProcess, 100);
repeat
dRead := 0;
try
ReadFile(hRead, pBuffer[0], CReadBuffer, dRead, nil);
except on E: Exception do
Exit;
end;
pBuffer[dRead] := #0;
//OemToAnsi(pBuffer, pBuffer);
//Unicode support by Lars Fosdal
OemToCharA(pBuffer, dBuffer);
CallBack(dBuffer);
until (dRead < CReadBuffer);
until (dRunning <> WAIT_TIMEOUT);
CloseHandle(piProcess.hProcess);
CloseHandle(piProcess.hThread);
end;
CloseHandle(hRead);
CloseHandle(hWrite);
end;
end;
I created this wrapper to simplify the process:
function GetDosOutputSimple(const ACommand, AParameters: String) : String;
var
Tmp, S : String;
begin
GetDosOutput(ACommand, AParameters, procedure (const Line: PAnsiChar)
begin
Tmp := Line;
S := S + Tmp;
end);
GetDosOutputSimple := S;
end;
See Question&Answers more detail:
os