home *** CD-ROM | disk | FTP | other *** search
/ Delphi 2 - Developers' Solutions / Delphi 2 Developers' Solutions.iso / dds / chap04 / howto04 / delphi10 / drwsutl1.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-10-12  |  1.6 KB  |  57 lines
  1. unit Drwsutl1;
  2.  
  3. interface
  4. uses
  5.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  6.   Forms, Dialogs, StdCtrls, Buttons, ExtCtrls, ShellAPI, FileCtrl;
  7.  
  8. function ShellExec(const PathStr, CmdStr, DirStr: string;
  9.   PrintIt: boolean; Show: word; Wait: boolean): boolean;
  10.  
  11. implementation
  12.  
  13. { This function is from Delphi How To Copyright 1995 Waite Group Press }
  14. function ShellExec(const PathStr, CmdStr, DirStr: string;
  15.   PrintIt: boolean; Show: word; Wait: boolean): boolean;
  16. var
  17.   Inst: THandle;
  18.   Path, CmdLine, Dir: PChar;
  19.   Op: array[0..5] of Char;
  20.   AppWin: hWnd;
  21.   Valid: Bool;
  22. begin
  23.   if PrintIt then StrPCopy(Op, 'print') else StrPCopy(Op, 'open');
  24.   { Get memory for PChars }
  25.   GetMem(Path, Length(PathStr)+1);
  26.   GetMem(CmdLine, Length(CmdStr)+1);
  27.   GetMem(Dir, Length(DirStr)+1);
  28.   try
  29.     { Copy strings to PChars }
  30.     StrPCopy(Path, PathStr);
  31.     StrPCopy(CmdLine, CmdStr);
  32.     StrPCopy(Dir, DirStr);
  33.     { Execute file }
  34.     Inst := ShellExecute(0, Op, Path, CmdLine, Dir, Show);
  35.     { If 32 or less, an error occurred }
  36.     if Inst <= 32 then Result := False else
  37.     begin
  38.       if Wait then
  39.       begin
  40.         { Loop while program is running }
  41.         while GetModuleUsage(Inst) <> 0 do
  42.           Application.ProcessMessages;
  43.         { Acknowledge error from last iteration of loop }
  44.         OutputDebugString('--> Please ignore the previous error'#10#13);
  45.       end;
  46.       Result := True;
  47.     end;
  48.   finally
  49.     { Ensure memory is freed }
  50.     FreeMem(Path, Length(PathStr)+1);
  51.     FreeMem(CmdLine, Length(CmdStr)+1);
  52.     FreeMem(Dir, Length(DirStr)+1);
  53.   end;
  54. end;
  55.  
  56. end.
  57.