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