[Back to WIN-OS2 SWAG index]  [Back to Main SWAG index]  [Original]



(* This is a program that should ensure only 1 copy of a dos program *)
(* will be able to run under windows.                                *)
(* There are 2 options                                               *)
(* - = add a startup directory                                       *)
(* @ = Look for an alternate window title                            *)
(* you may look at the help below                                    *)

{$I-}

Uses
  Strings,
  WinProcs,
  WinTypes;

Const
  ExeError: Array[0..21] of PChar =
  ('System was out of memory, executable file was corrupt, or relocations were invalid.'+
   '  or you may be trying to run a com file without adding .com'#13'Example - EDIT.COM',
   '',
   'File was not found.',
   'Path was not found.',
   '',
   'Attempt was made to dynamically link to a task, or there was a sharing or network-protection error.',
   'Library required separate data segments for each task.',
   '',
   'There was insufficient memory to start the application.',
   '',
   'Windows version was incorrect.',
   'Executable file was invalid. Either it was not a Windows application or there was an error in the .EXE image.',
   'Application was designed for a different operating system.',
   'Application was designed for MS-DOS 4.0.',
   'Type of executable file was unknown.',
   'Attempt was made to load a real-mode application (developed for an earlier version of Windows).',
   'Attempt was made to load a second instance of an executable file containing multiple data segments that were '+
   'not marked read-only.',
   '',
   '',
   'Attempt was made to load a compressed executable file. The file must be decompressed before it can be loaded.',
   'Dynamic-link library (DLL) file was invalid. One of the DLLs required to run this application was corrupt.',
   'Application requires 32-bit extensions.');


Const
  DosError: Array[2..11] of PChar =
  ('File not found','Path not found','','Access denied','Invalid handle',
   '','Not enough memory','','Invalid environment','Invalid format');

Var
  Path       : String;      (* Path and program name of program to run - from the command line *)
  StartupDir : String;      (* Directory information removed from the above *)
  WindowTitle : String[20];  (* Name of the DOS window - appears in the title bar *)


Function Trim(S: String): String;
Begin
  While Copy(S,1,1) = ' ' Do
    Delete(S,1,1);
  Trim := S;
End;

Function GetToken(Var S: String;Marker: Char): String;
Var
  P : Integer;
Begin
  P := Pos(Marker,S);
  If P = 0 Then
    P := Length(S);
  GetToken := Copy(S,1,P-1);
  Delete(S,1,P);
  S := Trim(S);
End;

Procedure DispParams;
Var
  Msg: String;
Begin
  Msg := 'Path        :'+Path+#13+
         'Start Dir   :'+StartupDir+#13+
         'WindowTitle :'+WindowTitle;
  While pos(#0,Msg) > 0 Do
    Delete(Msg,pos(#0,Msg),1);
  Msg := Msg +#0;

  MessageBox(0,@Msg[1],'Program Start Information',mb_OK);
End;

Procedure SayErrorHalt(Msg: String);
Begin
  Msg := Msg+#0;
  If MessageBox(0,@Msg[1],'Program Start Error',mb_OKCancel) = id_OK then
    DispParams;
  Halt;
End;

Procedure SayDOSErrorHalt(Err: Integer;Msg: String);
Var
  ErrStr: String[10];  (* Used when there is an execute error *)
Begin
  Str(Err,ErrStr);

  Msg := StrPas(DosError[Err])+#13+'Error: '+ErrStr+' '+Msg+#0;
  If MessageBox(0,@Msg[1],'Program Start Error',mb_OKCancel) = id_OK then
    DispParams;
  Halt;
End;

Procedure SayExeErrorHalt(Err: Integer;Msg: String);
Var
  ErrStr: String[10];  (* Used when there is an execute error *)
Begin
  Str(Err,ErrStr);

  Msg := StrPas(EXEError[Err])+#13+'Error: '+ErrStr+' '+Msg+#0;
  If MessageBox(0,@Msg[1],'Program Start Error',mb_OKCancel) = id_OK Then
    DispParams;
  Halt;
End;

Var
  InstanceID : THandle;     (* Handle to the executed program - Just used here to check for errors *)
  Wnd        : hWnd;        (* Handle to the window of the program *)
  iStart     : Integer;     (* Used in finding the above *)
  iEnd       : Integer;
  CmdPos     : Integer;     (* Position of the program to execute in the system.CmdLine *)
  Result     : Integer;     (* Check for IO errors *)
Begin
  Path := Trim(StrPas(CmdLine));

  (* If any one tries this with a windows program *)
  If (pos(Copy(Path,1,1),'?') > 0) or (Path = '') Then
    Begin
      If MessageBox(0,'ONEEXE is a program that will ensure'#13+
                   'that only one copy of a DOS program'#13+
                   'is active on a machine.  If the DOS'#13+
                   'program is already running ONEEXE will'#13+
                   'call up the previous copy, if not it will'#13+
                   'start the program.'#13+
                   'PRESS ENTER FOR EXAMPLES',
                   'Program Info',
                   mb_OKCancel) = id_OK Then

      MessageBox(0,'Usage:'+#13+
                   '  EXEONE [@"window name"] [-startup directory] filename'+#13+
                   'Examples:'+#13+
                   '  EXEONE COMMAND.COM'+#13+
                   '  EXEONE -C:\PASFILE D:\BP\BIN\BP.EXE'+#13+
                   '  ^ERR - title change'#13+
                   '  EXEONE @"BORLAND PASCAL 7.0" -C:\PASFILE bp.exe'#13+
                   '  ^works'#13+
                   '  EXEONE C:\DATA G:\PROGS\CONTACT.EXE',
                   'Program Example Info',
                   mb_OK);
      Halt;
    End;

  (* Set the defaults for no startup directory *)
  WindowTitle := '';  (* Flag no window name specified *)

  (* See if there is a startup directory *)

  While Pos(Copy(Path,1,1),'-@') > 0 Do
    Begin
      If Copy(Path,1,1) = '-' Then
        Begin
          Delete(Path,1,1); (* Remove the '-' signature *)
          StartupDir := GetToken(Path,' ');

          (* Clean the path of extra "|" *)
          While (Length(StartupDir) > 0) and (Pos(StartupDir[Length(StartupDir)],'\ ') > 0) Do
            Delete(StartupDir,Length(StartupDir),1);
          ChDir(StartupDir);
          Result := IoResult;
          If Result <> 0 Then
            SayDOSErrorHalt(Result,'changing directories '+#13+StartupDir);
        End;

        (* Window name change - BP needs this *)
      If Copy(Path,1,1) = '@' Then
        Begin
          Delete(Path,1,1); (* Remove the '-' signature *)
          If Copy(Path,1,1) = '"' Then
            Begin
              Delete(Path,1,1); (* Remove the '"' part *)
              WindowTitle := GetToken(Path,'"');
            End
          Else
            WindowTitle := GetToken(Path,' ');
        End;
    End;

  (* Get Window Name - If the program is able to change it's name then this will not work *)
  (* Sorry - The only way to make it work would be to add an name change option *)
  If WindowTitle = '' Then
    Begin
      iStart := Length(Path);
      While (iStart > 0) and (Path[iStart] <> '\') Do
        Dec(iStart);
      Inc(iStart);
      iEnd := Pos('.',Path);
      If iEnd = 0 Then
        iEnd := Length(Path)
      Else
        Dec(iEnd);
      (* Add #0 so these may work as params to windows API *)
      WindowTitle := Copy(Path,iStart,iEnd-iStart+1)+#0;
    End;

  If Path = '' Then
    SayErrorHalt('There is no program path.'#13+
                 'Check for accuracy of your'#13+
                 'commad line.');

  Path := Path + #0;  (* Set it up for passing the the API *)
  (* Check for existing dos window *)
  Wnd := FindWindow('tty',@WindowTitle[1]);
  If Wnd = 0 Then  (* If it is not running *)
    Begin          (* Start it *)
      InstanceID := WinExec(@Path[1],sw_ShowNormal);
      If InstanceID < 32 Then
        SayEXEErrorHalt(Result,'running program '+#13+Path);
    End
  Else
    Begin
      BringWindowToTop(Wnd);       (* Bring it to the top *)
      ShowWindow(Wnd,sw_Restore);  (* And Restore it *)
    End;
End.


[Back to WIN-OS2 SWAG index]  [Back to Main SWAG index]  [Original]