Try to use Createprocess to start windows Explorer in a given path, but I keep getting
System Error. Code 50. The request is not supported.
What am i doing wrong?
procedure TfrmProjectManager.OpenFolderinExplorer(const aPath: string);
function GetWinDir: String;
var
Buffer: array[0..MAX_PATH] of Char;
begin
GetWindowsDirectory(Buffer, SizeOf(Buffer));
SetString(Result, Buffer, StrLen(Buffer));
end;
var
strCmdLine : String;
fStartInfo : TStartupInfo;
fProcessInfo : TProcessInformation;
begin
try
if sysutils.DirectoryExists(aPath) or
(MessageDlg('Folder [%s] not found. Create it?', mtConfirmation, mbYesNo, 0)=mrYes) then
begin
sysutils.ForceDirectories(aPath);
FillChar(fStartInfo,sizeof(fStartInfo),0);
FillChar(fPRocessInfo, Sizeof(fProcessInfo),0);
fStartInfo.cb:=sizeof(fStartInfo);
fStartInfo.lpReserved := nil;
fStartInfo.lpDesktop := nil;
fStartInfo.lpTitle := nil;
fStartInfo.dwFlags := STARTF_USESHOWWINDOW ;
fStartInfo.wShowWindow := SW_SHOW;
fStartInfo.cbReserved2 := 0;
fStartInfo.lpReserved2 := nil;
strCmdLine := '"' + GetWinDir + '\explorer.exe"';
if not CreateProcess(nil,PChar(strCmdLine),nil,nil,False, 0,nil,PChar(aPath),fStartInfo,fProcessInfo) then
RaiseLastOSError;
end
except
on E:TObject do
if not IsAbortException(E) then
raise;
end;
end;
I tried various combinations of parameters in CreateProcess, but just don't seem able to find the correct one.
I'd say that you shouldn't be using CreateProcess here. Rather than debugging your CreateProcess I'll offer you what I believe to be the right way to open a shell view onto a folder. Call ShellExecute.
ShellExecute(0, '', PChar(aPath), '', '', SW_SHOWNORMAL);
This way you let the shell decide on the appropriate way to display the folders contents to the user.
Related
I have one installation that behaves VERY oddly... Every time we try to copy something on a network drive we check accessibility with code like this:
procedure TForm1.TestAccess;
var fn : string;
hdl : THandle;
res : boolean;
dir : string;
flags : Cardinal;
begin
dir := edDir.Text;
flags := FILE_FLAG_DELETE_ON_CLOSE or FILE_FLAG_NO_BUFFERING or FILE_ATTRIBUTE_HIDDEN;
fn := FindUnusedFileName( IncludeTrailingPathDelimiter( dir ) + IntToStr( Random(10000) ) + '.tst' );
memLog.Lines.Add('Try to create file: ' + fn);
hdl := CreateFile( PChar(fN), GENERIC_READ or GENERIC_WRITE, FILE_SHARE_DELETE, nil, CREATE_NEW,
flags, 0 );
res := hdl <> INVALID_HANDLE_VALUE;
if not res then
begin
memLog.Lines.Add('Error: ' + SysErrorMessage(GetLastError));
end
else
memLog.Lines.Add('Success');
if res then
CloseHandle(hdl);
end;
where memLog is a TMemo and edDir is simply an edit field.
Now here is the strange part... I get an access denied on that system meaning uploading will fail most of the time (most of the time is the strange part here).
Another thing is that in a first attempt I used the JvDirectoryEdit control. In that case the result is twofold... If I enter the directory (UNC Path) there without a backslash I get the access denied too. If I enter a final backslash and the combo box window pops up showing the content (aka directories) in that folder it finally works!!!
So... First: has anyone a clue what the problem might be and do I something wrong here?
I have used this procedure in the past to check if a directory is read-only, maybe it can be useful:
FUNCTION DirRO(NomeCartella : String) : Boolean;
VAR VarFile : TextFile;
NomCart : String;
BEGIN
Result := False;
If NomeCartella[Length(NomeCartella)]='\'
Then NomCart := NomeCartella
Else NomCart := NomeCartella+'\';
Try AssignFile(VarFile,NomCart+'^ghi.kol');
{$I-}
Rewrite(VarFile);
{$I-}
If IOResult<>0 Then
Begin
Result := True;
Exit;
End;
CloseFile(VarFile);
Erase(VarFile);
Except Result := True;
End;
END;
Apologies for improper terminology when referencing Delphi's VCL/main thread structure (if anyone has any resources to learn more about this I would appreciate it).
Basically, I have a VCL application where on a button click event, I want the user to be unable to interact with the initial VCL application that spawns the external exe.
I have a function called ExecuteExternalProcess that when passed the proper parameters, will not allow the next line(s) of code to execute until the external application has returned a value. This works well in other applications, but not so much when we are spawning the external exe from a VCL event.
Here is the Button Click Event that spawns the external process
procedure TMainForm.ButtonBtnClick(Sender: TObject);
var
error: Integer;
begin
ExecuteExternalProcess('test.exe', '', '', True, false, false, error);
showmessage('done');
end;
So this works, it doesn't display the 'done' message until the test.exe has finished executing. To reiterate, the issue is that while test.exe is running I can interact with the initial VCL application and do basically anything. I would like for the initial VCL application to stop completely and be inoperable until test.exe has finished executing.
Here is the code that spawns the exe if its any help(I am not the author I got it from here):
function ExecuteExternalProcess(const FileName, Params: string; Folder: string; WaitUntilTerminated, WaitUntilIdle, RunMinimized: boolean;
var ErrorCode: integer): boolean;
var
CmdLine: string;
WorkingDirP: PChar;
StartupInfo: TStartupInfo;
ProcessInfo: TProcessInformation;
begin
Result := true;
CmdLine := '"' + FileName + '" ' + Params;
//if Folder = '' then Folder := ExcludeTrailingPathDelimiter(ExtractFilePath(FileName));
ZeroMemory(#StartupInfo, SizeOf(StartupInfo));
StartupInfo.cb := SizeOf(StartupInfo);
if RunMinimized then
begin
StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
StartupInfo.wShowWindow := SW_SHOWMINIMIZED;
end;
if Folder <> '' then WorkingDirP := PChar(Folder)
else WorkingDirP := nil;
if not CreateProcess(nil, PChar(CmdLine), nil, nil, false, 0, nil, WorkingDirP, StartupInfo, ProcessInfo) then
begin
Result := false;
ErrorCode := GetLastError;
exit;
end;
with ProcessInfo do
begin
CloseHandle(hThread);
if WaitUntilIdle then WaitForInputIdle(hProcess, INFINITE);
if WaitUntilTerminated then
repeat
Application.ProcessMessages;
until MsgWaitForMultipleObjects(1, hProcess, false, INFINITE, QS_ALLINPUT) <> WAIT_OBJECT_0 + 1;
CloseHandle(hProcess);
end;
end;
Why not just disable the tmainform.
I'm using Windows API to recursively delete many files and folders. I'm using it without a UI and suppressing errors. The problem is, it completely fails if one of those files is in use. I expect that possibility, and want this to continue anyway, skipping any such cases. The one file which fails is actually the same EXE which is calling this delete command (which will be deleted after it's all done anyway.
Here's what I'm doing now:
procedure DeleteDirectory(const DirName: string);
var
FileOp: TSHFileOpStruct;
begin
FillChar(FileOp, SizeOf(FileOp), 0);
FileOp.wFunc := FO_DELETE;
FileOp.pFrom := PChar(DirName+#0);//double zero-terminated
FileOp.fFlags := FOF_SILENT or FOF_NOERRORUI or FOF_NOCONFIRMATION;
SHFileOperation(FileOp);
end;
How can I make this skip any event of a file being in use? I looked at the documentation but can't find anything that can do this.
Here is just an idea you can implement in your function to validate if there is any file in use:
function IsFileInUse(FileName: TFileName): Boolean;
var
HFileRes: HFILE;
begin
Result := False;
if not FileExists(FileName) then
Exit;
HFileRes := CreateFile(PChar(FileName),
GENERIC_READ or GENERIC_WRITE,
0,
nil,
OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL,
0);
Result := (HFileRes = INVALID_HANDLE_VALUE);
if not Result then
CloseHandle(HFileRes);
end;
Maybe it can help you.
Why don't you try this:
procedure DeleteFiles(const DirName: String);
var
SR: TSearchRec;
i: Integer;
begin
//get all files in directory
i := FindFirst(DirName +'\*.*', faAnyFile, SR);
while i = 0 do
begin
if (SR.Attr and faDirectory) <> faDirectory then
DeleteFile(DirName +'\'+ SR.Name);
i := FindNext(SR);
end;
FindClose(SR);
end;
It's another way to do it.
I have multiple services processing some files. Each service must have exclusive access to the file while processing. I solved this problem a while ago by creating a global mutex that uses some temp files, something like this:
function AppLocked: boolean;
begin
result := FileExists(GetTempDir + '__MUTEX__' + LockExt);
end;
procedure AppLock;
var
F: TextFile;
begin
if FileExists(GetTempDir + '__MUTEX__' + LockExt) then
exit
else
try
AssignFile(F, GetTempDir + '__MUTEX__' + LockExt);
Rewrite(F);
Writeln(F, DateTimeToStr(Now));
CloseFile(F);
except
end;
end;
procedure AppUnLock;
begin
if FileExists(GetTempDir + '__MUTEX__' + LockExt) then
SysUtils.DeleteFile(GetTempDir + '__MUTEX__' + LockExt);
end;
This works pretty good, and I don't want to fix something that works, but I just wonder, is there a better solution?
An actual Mutex (as in win32 Mutex) is the preferred method.
Your solution has a problem, if the application terminates and you missed to unlock. This could happen on an abnormal termination. It would be better to create a file, that will automatically erase itself if the application terminates.
All the magic is done by FILE_FLAG_DELETE_ON_CLOSE
unit uAppLock;
interface
function AppLocked : Boolean;
function AppLock : Boolean;
procedure AppUnlock;
implementation
uses
Windows, SysUtils, Classes;
var
// unit global variable
LockFileHandle : THandle;
// function to build the filename
function GetLockFileName : string;
begin
// You have to point out, where to get these informations
Result := GetTempDir + '__MUTEX__' + LockExt;
end;
function AppLocked : Boolean;
begin
Result := FileExists( GetLockFileName );
end;
function AppLock : Boolean;
var
LFileName : string;
LLockFileStream : TStream;
LInfoStream : TStringStream;
begin
Result := False;
if AppLock
then
Exit;
LFileName := GetLockFileName;
// Retrieve the handle of the LockFile
LockFileHandle := CreateFile( PChar( LFileName ), GENERIC_READ or GENERIC_WRITE, FILE_SHARE_READ or FILE_SHARE_DELETE,
nil, CREATE_NEW, FILE_FLAG_DELETE_ON_CLOSE or FILE_ATTRIBUTE_TEMPORARY, 0 );
if LockFileHandle <> INVALID_HANDLE_VALUE
then
begin
Result := True;
LInfoStream := nil;
LLockFileStream := nil;
try
LInfoStream := TStringStream.Create;
LInfoStream.WriteString( DateTimeToStr( Now ) );
LInfoStream.Seek( 0, soFromBeginning );
LLockFileStream := THandleStream.Create( LockFileHandle );
LLockFileStream.CopyFrom( LInfoStream, LInfoStream.Size );
finally
LInfoStream.Free;
LLockFileStream.Free;
end;
end;
end;
procedure AppUnlock;
begin
// Just close the handle and the file will be deleted
CloseHandle( LockFileHandle );
end;
end.
BTW: GetTempDir looks to be a Directory, but you use it as a Path. So it would be better to rename it into GetTempPath instead :o)
I have a commandline application coded in delphi that I need to call from a normal desktop application (also coded in delphi). In short, I want to call the commandline app and display the text it outputs "live" in a listbox.
It's been ages since I have played around with the shell, but I distinctly remember that in order to grab the text from a commandline app - I have to use the pipe symbol ">". Like this:
C:/mycmdapp.exe >c:/result.txt
This will take any text printed to the shell (using writeLn) and dump it to a textfile called "result.txt".
But.. (and here comes the pickle), I want a live result rather than a backlog file. A typical example is the Delphi compiler itself - which manages to report back to the IDE what is going on. If my memory serves me correctly, I seem to recall that I must create a "pipe" channel (?), and then assign the pipe-name to the shell call.
I have tried to google this but I honestly was unsure of how to formulate it. Hopefully someone from the community can point me in the right direction.
Updated: This question might be identical to How do I run a command-line program in Delphi?. Some of the answers fit what I'm looking for, although the title and question itself is not identical.
As ever so often Zarco Gajic has a solution: Capture the output from a DOS (command/console) Window. This is a copy from his article for future reference:
The example runs 'chkdsk.exe c:\' and displays the output to Memo1.
Put a TMemo (Memo1) and a TButton (Button1) on your form. Put this code in the OnCLick event procedure for Button1:
procedure RunDosInMemo(DosApp: string; AMemo:TMemo);
const
READ_BUFFER_SIZE = 2400;
var
Security: TSecurityAttributes;
readableEndOfPipe, writeableEndOfPipe: THandle;
start: TStartUpInfo;
ProcessInfo: TProcessInformation;
Buffer: PAnsiChar;
BytesRead: DWORD;
AppRunning: DWORD;
begin
Security.nLength := SizeOf(TSecurityAttributes);
Security.bInheritHandle := True;
Security.lpSecurityDescriptor := nil;
if CreatePipe({var}readableEndOfPipe, {var}writeableEndOfPipe, #Security, 0) then
begin
Buffer := AllocMem(READ_BUFFER_SIZE+1);
FillChar(Start, Sizeof(Start), #0);
start.cb := SizeOf(start);
// Set up members of the STARTUPINFO structure.
// This structure specifies the STDIN and STDOUT handles for redirection.
// - Redirect the output and error to the writeable end of our pipe.
// - We must still supply a valid StdInput handle (because we used STARTF_USESTDHANDLES to swear that all three handles will be valid)
start.dwFlags := start.dwFlags or STARTF_USESTDHANDLES;
start.hStdInput := GetStdHandle(STD_INPUT_HANDLE); //we're not redirecting stdInput; but we still have to give it a valid handle
start.hStdOutput := writeableEndOfPipe; //we give the writeable end of the pipe to the child process; we read from the readable end
start.hStdError := writeableEndOfPipe;
//We can also choose to say that the wShowWindow member contains a value.
//In our case we want to force the console window to be hidden.
start.dwFlags := start.dwFlags + STARTF_USESHOWWINDOW;
start.wShowWindow := SW_HIDE;
// Don't forget to set up members of the PROCESS_INFORMATION structure.
ProcessInfo := Default(TProcessInformation);
//WARNING: The unicode version of CreateProcess (CreateProcessW) can modify the command-line "DosApp" string.
//Therefore "DosApp" cannot be a pointer to read-only memory, or an ACCESS_VIOLATION will occur.
//We can ensure it's not read-only with the RTL function: UniqueString
UniqueString({var}DosApp);
if CreateProcess(nil, PChar(DosApp), nil, nil, True, NORMAL_PRIORITY_CLASS, nil, nil, start, {var}ProcessInfo) then
begin
//Wait for the application to terminate, as it writes it's output to the pipe.
//WARNING: If the console app outputs more than 2400 bytes (ReadBuffer),
//it will block on writing to the pipe and *never* close.
repeat
Apprunning := WaitForSingleObject(ProcessInfo.hProcess, 100);
Application.ProcessMessages;
until (Apprunning <> WAIT_TIMEOUT);
//Read the contents of the pipe out of the readable end
//WARNING: if the console app never writes anything to the StdOutput, then ReadFile will block and never return
repeat
BytesRead := 0;
ReadFile(readableEndOfPipe, Buffer[0], READ_BUFFER_SIZE, {var}BytesRead, nil);
Buffer[BytesRead]:= #0;
OemToAnsi(Buffer,Buffer);
AMemo.Text := AMemo.text + String(Buffer);
until (BytesRead < READ_BUFFER_SIZE);
end;
FreeMem(Buffer);
CloseHandle(ProcessInfo.hProcess);
CloseHandle(ProcessInfo.hThread);
CloseHandle(readableEndOfPipe);
CloseHandle(writeableEndOfPipe);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin {button 1 code}
RunDosInMemo('chkdsk.exe c:\',Memo1);
end;
Update:
The above example reads the output in one step. Here is another example from DelphiDabbler showing how the output can be read while the process is still running:
function GetDosOutput(CommandLine: string; Work: string = 'C:\'): 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); // don't redirect stdin
hStdOutput := StdOutPipeWrite;
hStdError := StdOutPipeWrite;
end;
WorkDir := Work;
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;
You probably have the code on your harddisk already: the Execute function in the JclSysUtils unit of the JCL (JEDI Code Library) does what you need:
function Execute(const CommandLine: string; OutputLineCallback: TTextHandler;
RawOutput: Boolean = False; AbortPtr: PBoolean = nil): Cardinal;
You can supply it with a callback procedure:
TTextHandler = procedure(const Text: string) of object;
Did an answer too for better understanding:
{type TTextHandler =} procedure TTextHandlerQ(const aText: string);
begin
memo2.lines.add(atext);
end;
writeln(itoa(JExecute('cmd /C dir *.*',#TTextHandlerQ, true, false)));
You have to use /C then cmd /c is used to run commands in MS-DOS and terminate after command or process completion, otherwise it blocks output to memo.