/ShellStuff_win.pas

  1unit ShellStuff_win;
  2
  3interface
  4
  5uses Windows;
  6
  7{ Copies a list of files (separated by #0) from ASource to ADest, both strings
  8  must contain the same number of files
  9  Will rename the copied file if ARenameCheck is true, replace otherwise
 10  Will never ask for rename or rewrite action
 11  Creates new directories if necessary
 12  Displays the OS copy dialogue
 13  Returns true on success, false otherwuse, use GetLastError for details in the
 14  latter case }
 15function  ShellCopyFile(const ASource, ADest:  String; ARenameCheck: Boolean = false): Boolean;
 16
 17{ Deletes a file, a folder or a list of both (separated by #0)
 18  Is silent (does not display OS delete dialogue) and does not move to trash
 19  Returns true on success, false otherwuse, use GetLastError for details in the
 20  latter case }
 21function  ShellDeleteFile(FileName : String): Boolean;
 22
 23{ Executes program FileName in ExeDir and passes parameters Params
 24  ExeDir defaults to the directory this application is in
 25  Verb can be changed for non-binary files to 'open' or 'explore' for example,
 26  see the ShellAPI documentation for more info
 27  If WaitForFinish is true the function will not return until the executed
 28  process has been terminated (is finished)
 29  Returns true on success, false otherwise, use GetLastError for details in the
 30  latter case }
 31function  ExecuteProgram(const FileName : String; const Params : String;
 32    const ExecDir : String = ''; const Verb : String = 'runas';
 33    const WaitForFinish : Boolean = true) : Boolean;     
 34
 35{ Tries to convert a DOS path into a POSIX path used by Cygwin applications
 36  The Linux version should simply return Path or convert any '\' to '/' }
 37function ConvertPath(const Path : String) : String;
 38
 39implementation
 40
 41uses ShellAPI, Forms, SysUtils;
 42
 43function ShellCopyFile(const ASource, ADest: String; ARenameCheck: Boolean = false): Boolean;
 44var
 45    sh: TSHFileOpStruct;
 46begin
 47    sh.Wnd := Application.Handle;
 48    sh.wFunc := FO_COPY;
 49    // String has to be terminated with #0#0
 50    sh.pFrom := PChar(ASource + #0);
 51    sh.pTo := PChar(ADest + #0);
 52    sh.fFlags := FOF_MULTIDESTFILES or FOF_NOCONFIRMATION or FOF_NOCONFIRMMKDIR;
 53    if ARenameCheck then
 54        sh.fFlags := sh.fFlags or FOF_RENAMEONCOLLISION;
 55    Result := (ShFileOperation(sh) = 0);
 56end;
 57
 58function ShellDeleteFile(FileName : String): Boolean;
 59var
 60    sh: TSHFileOpStruct;
 61begin
 62    sh.Wnd := Application.Handle;
 63    sh.wFunc := FO_DELETE;
 64    sh.fFlags := FOF_SILENT OR FOF_NOCONFIRMATION;
 65    sh.pFrom := PChar(FileName + #0);
 66    sh.pTo := #0;
 67    Result := (ShFileOperation(sh) = 0);
 68end;
 69
 70function  ExecuteProgram(const FileName : String; const Params : String;
 71    const ExecDir : String = ''; const Verb : String = 'runas';
 72    const WaitForFinish : Boolean = true) : Boolean;
 73var
 74    ShExecInfo : SHELLEXECUTEINFO;
 75    ExitCode : Cardinal;
 76    OSInfo : OSVERSIONINFO;
 77begin
 78    // Get Windows version to switch between 'runas' and 'open' verb
 79    GetVersionEx(OSInfo);
 80
 81    ShExecInfo.Wnd          := Application.Handle;
 82    ShExecInfo.fMask        := SEE_MASK_NOCLOSEPROCESS;
 83    ShExecInfo.cbSize       := SizeOf(SHELLEXECUTEINFOW);
 84    if (Verb = 'runas') AND ((OSInfo.dwMajorVersion < 6) // XP and older
 85        OR (ExtractFileExt(FileName) <> 'exe')) then // only use 'runas' on .exe (won't work for .bat)
 86        ShExecInfo.lpVerb   := PChar('open')
 87    else
 88        ShExecInfo.lpVerb   := PChar(Verb);
 89    ShExecInfo.lpFile       := PChar(FileName);
 90    ShExecInfo.lpParameters := PChar(Params);
 91    if ExecDir = '' then
 92        ShExecInfo.lpDirectory := PChar(ExtractFileDir(Application.ExeName))
 93    else
 94        ShExecInfo.lpDirectory := PChar(ExecDir);
 95    ShExecInfo.nShow        := SW_SHOW;
 96    Result := ShellExecuteEx(@ShExecInfo);
 97
 98    if WaitForFinish AND Result then
 99    begin
100        ExitCode := STILL_ACTIVE;
101        repeat
102            GetExitCodeProcess(ShExecInfo.hProcess,ExitCode); //while the process is running
103        until (ExitCode <> STILL_ACTIVE);
104    end;
105end;   
106
107function ConvertPath(const Path : String) : String;
108var
109    Drive : String;
110begin
111    Drive := ExtractFileDrive(Path);
112    Result := Path;
113    if Length(Drive) > 1 then
114    begin
115        Result := StringReplace(Result,Drive,'',[]);
116        Result := 'cygdrive/' + Drive[1] + Result;
117    end;
118    Result := StringReplace(Result,'\','/',[rfReplaceAll]);
119end;
120
121end.