File:  [mozdev] / mozptch / shell_func.pas
Revision 1.3: download - view: text, annotated - select for diffs - revision graph
Sun May 30 19:51:15 2004 UTC (15 years, 10 months ago) by oertel
Branches: MAIN
CVS tags: version_30_05_04, HEAD
-Linux support ready for delivery (beta)
-New Variables for EmailAddress, ncoming and outgoing server
-INI-Files debuged
- new bin zip file

(* Copyright (c) uib umwelt informatik buero gmbh (www.uib.de)
 This sourcecode is owned by uib
 and published under the Terms of the General Public License.
#*###CVS_HEAD_START###******************************************************
# $Id: shell_func.pas,v 1.3 2004/05/30 19:51:15 oertel Exp $
#
#*###EXCLUDE_CVS_LOG###*****************************************************
# History:
# ========
#
# $Log: shell_func.pas,v $
# Revision 1.3  2004/05/30 19:51:15  oertel
# -Linux support ready for delivery (beta)
# -New Variables for EmailAddress, ncoming and outgoing server
# -INI-Files debuged
# - new bin zip file
#
# Revision 1.1  2004/03/14 12:49:07  oertel
# Initial commit version 9.29
#
*)
unit shell_func;


interface
{$IFDEF MSWINDOWS}
uses

  sysutils, WinTypes, Winprocs, Messages, Forms, Dialogs, ShellApi;



function StartProcess (CmdLinePasStr : String; ShowWindowFlag : Integer;
                       WaitForReturn : Boolean;
                       Var Report : String): Boolean;


function start(commandline : string) : boolean;
function startfile(commandline : string) : boolean;
function startprogram(commandline : string; parameters : string) : boolean;
{$ENDIF}

implementation

{$IFDEF MSWINDOWS}
procedure processmess;
begin
 Application.processmessages;
end;

function StartProcess (CmdLinePasStr : String; ShowWindowFlag : Integer;
                       WaitForReturn : Boolean;
                       Var Report : String): Boolean;


  var
  // StartupInfo : TStartupInfo;
  // ProcessInformation : TProcessInformation;
  // tokenhandle: thandle;

   executeInfo : TShellExecuteInfo;
   pExecuteInfo : PShellExecuteInfo;

   running : Boolean;
   lpExitCode : DWORD;

   WaitWindowStarted : Boolean;
   starttime, nowtime : TDateTime;

   line : String;
   filename : String;
   params : String;
   dir: String;
   firstsplit: Integer;
   len : DWord;
   functionresult : hinst;

   const secsPerDay = 86400;

 Begin
   {
    with StartupInfo do
     Begin
       cb := SizeOf (TStartupInfo);
       lpReserved  := nil;
       lpDesktop   := nil;
       lpTitle     := nil;
       dwFlags     := STARTF_USESHOWWINDOW;
       wShowWindow := ShowWindowFlag;
       lpReserved2 := nil;
     end;

    }

    if length(CmdLinePasStr) = 0
    then
    Begin
      result := false;
      Report := 'No file to execute';
      exit;
    end;

    params := '';

    if CmdLinePasStr[1] = '"'
    then
    Begin
      line := copy (CmdLinePasStr, 2, length (CmdLinePasStr));
      firstsplit := pos ('"', line);
      if firstsplit <= 0
      then
      Begin
        result := false;
        Report := 'No valid filename';
        exit;
      End;
      filename := copy (line, 1, firstsplit-1);
      params := copy (line, firstsplit + 1, length (line));
    end
    else
    Begin
      firstsplit := pos(' ', CmdLinePasStr);
      if firstsplit > 0
      then
      Begin
        filename := copy (CmdLinePasStr, 1, firstsplit - 1);
        params := copy (CmdLinePasStr, firstsplit + 1, length (CmdLinePasStr));
      End
      else
      Begin
        filename := CmdLinePasStr;
      End;
    End;

    with executeInfo do
    Begin
      cbSize := sizeOf (TShellExecuteInfo);

      fMask := SEE_MASK_NOCLOSEPROCESS; //leave the process running

      Wnd := 0;
      lpVerb := 'Open';
      lpFile := PChar (filename);
      lpParameters := PChar (params);
      lpDirectory := nil;
      nShow := ShowWindowFlag;
    {  hInstApp: HINST; }
    { Optional fields
       lpIDList: Pointer;
       lpClass: PWideChar;
       hkeyClass: HKEY;
       dwHotKey: DWORD;
       hIcon: THandle;
       hProcess: THandle;
       }

    End;

    pExecuteInfo := addr(executeInfo);


    //functionresult := ShellExecute (0, 'open', PChar (Filename), PChar(params), nil, showWindowFlag);
    //if functionresult <= 32

    if not ShellExecuteEx (pExecuteInfo)
    {
    if not CreateProcess (nil, PChar (CmdLinePasStr),
                     nil, nil, true, 0 (* CREATE_SEPARATE_WOW_VDM*), nil, nil,
                     StartupInfo, ProcessInformation)
    }
    then
    Begin
      result := false;
      Report :=  CmdLinePasStr + ' .... ShellExecute Error ' + IntToStr (functionResult)
                 + ' (' + SysErrorMessage (functionResult) + ')'
    End
    else

        Begin
      result := true;

      Report := 'Process started:    ' + CmdLinePasStr;

      if WaitForReturn
      then
      Begin
       running := true;
       while running do
       begin
         GetExitCodeProcess (ExecuteInfo.hProcess, lpExitCode);
         if lpExitCode <> still_active
         then running := false
         else Application.ProcessMessages
       End;

       Application.ProcessMessages;
      End;
    End;

 End;


function startShellExecute (CmdLinePasStr : String;
                       parameterPasStr : String;
                       ShowWindowFlag : Integer;
                       WaitForReturn : Boolean;
                       WaitForWindowVanished : Boolean; WindowToVanish : String;
                       Var Report : String): Boolean;
  var
   StartupInfo : TStartupInfo;
   ProcessInformation : TProcessInformation;


   running : Boolean;
   lpExitCode : DWORD;

   WaitWindowStarted : Boolean;

 Begin

    with StartupInfo do
     Begin
       cb := SizeOf (TStartupInfo);
       lpReserved  := nil;
       lpDesktop   := nil;
       lpTitle     := nil;
       dwFlags     := STARTF_USESHOWWINDOW;
       wShowWindow := ShowWindowFlag;
       lpReserved2 := nil;
     end;

    if 32 >= ShellExecute(Application.MainForm.Handle,NIL,PChar(CmdLinePasStr)
                       ,PChar(parameterPasStr),'',ShowWindowFlag)
    //if not CreateProcess (nil, PChar (CmdLinePasStr),
    //                 nil, nil, true, 0 (* CREATE_SEPARATE_WOW_VDM*), nil, nil,
    //                 StartupInfo, ProcessInformation)
    then
    Begin
      result := false;
      Report :=  CmdLinePasStr + ' .... CreateProcess Error ' + IntToStr (GetLastError)
                 + ' (' + SysErrorMessage (GetLastError) + ')';
    End
    else
    Begin
      result := true;

      if not WaitForReturn
      then
         Report := 'Process started:    ' + CmdLinePasStr
      else
      Begin
        running := true;
        WaitWindowStarted := false;
        while running do
        begin
          if WaitForWindowVanished and not WaitWindowStarted
          then
          Begin
            if FindWindowEx (0, 0, nil, PChar (WindowToVanish) ) <> 0
            then
              WaitWindowStarted := true
            else
              ProcessMess
          End
          else
          Begin
            if GetExitCodeProcess (ProcessInformation.hProcess, lpExitCode)
               and (lpExitCode <> still_active)
            then
            Begin
              if WaitForWindowVanished then
              Begin
                if FindWindowEx (0, 0, nil, PChar (WindowToVanish) ) = 0
                then running := false
                else ProcessMess;
              End
              else
              Begin
                (* ProcessMess;
                if MyMessageDlg.WiMessage ('Exit Process  Code ' + IntToStr (lpExitCode)
                                           + '   ' + CmdLinePasStr, [mrYes, mrNo])
                  = mrYes
                then *)
                running := false
              End
            End
            else ProcessMess
          End
        End;

        ProcessMess;
        Report := 'Process executed    ' + CmdLinePasStr
      End;
    End;

 End;


function start(commandline : string) : boolean;
 var
  option, report : String;
 begin
  if not StartProcess (commandline, sw_shownormal, true,Report)
  then
  Begin
   messageDlg('Error: ' + Report,mtError,[mbOK],0);
   result := false;
  End
  else
  begin
    result := true;
    //messageDlg('Success: ' + Report,mtInformation,[mbOK],0);
  end;
 end;

 function startfile(commandline : string) : boolean;
 var
  option, report : String;
 begin
  if not startShellExecute(commandline, '', sw_shownormal, false, false, '', Report)
  then
  Begin
   messageDlg('Error: ' + Report,mtError,[mbOK],0);
   result := false;
  End
  else
  begin
    result := true;
    //messageDlg('Success: ' + Report,mtInformation,[mbOK],0);
  end;
 end;

 function startprogram(commandline : string; parameters : string) : boolean;
 var
  option, report : String;
 begin
  if not startShellExecute(commandline, parameters, sw_shownormal, false, false, '', Report)
  then
  Begin
   messageDlg('Error: ' + Report,mtError,[mbOK],0);
   result := false;
  End
  else
  begin
    result := true;
    //messageDlg('Success: ' + Report,mtInformation,[mbOK],0);
  end;
 end;
{$ENDIF}

end.

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>