Quelltext /~heha/hs/dos/dosmisc.zip/SRC/STARTRUN.PAS

{$A+,B-,D-,F-,G+,I-,K+,L-,N-,P+,Q-,R-,S-,T+,V+,W-,X+,Y-}
{$M 12000,0}
program startrun;
{$C MOVEABLE PRELOAD PERMANENT}
{$D Hilfsprogramm für START.BAT - Windows-Programme von Kommandozeile starten}
{Im Falle von "start /wait" wird zz. nur eine wartende VM unterstützt}
{Hinauswurf durch nochmaliges Starten dieses Programms}
{Fehlt noch: Lieferung des Icons und des akt. Verzeichnisses für DOS-Boxen}

{V.1.03 h#s 10/02}
uses WinProcs,WinTypes,Win31,CommDlg,ToolHelp,ShellApi, WUtils;

var
 IniName: array[0..79] of Char;	{im Temp-Vrz.}
 WaitInst: THandle;	{für ToolHelp-Hook}

procedure TimerProc(Wnd:HWnd; Msg,wParam:Word; lParam:LongInt); export;
 label again;
 var
  name,args,dir,s1,s2: array[0..127] of Char;
  ext: PChar;
  Wait: Integer;
  inst: THandle;
  f: Text;
  ofn: TOpenFileName absolute f;
 begin
{  MessageBeep($FFFF);}
  if WaitInst<>0 then exit;	{Hier nur ein wartender Prozess!}
  Assign(f,IniName); Reset(f);
  if IOResult<>0 then exit;
  ReadLn(f,CmdShow);
  ReadLn(f,Wait);
  ReadLn(f,dir); OemToAnsi(dir,dir);
  ReadLn(f,name); OemToAnsi(name,name);
  if IOResult<>0 then exit;
  ReadLn(f,args); OemToAnsi(args,args);
  Close(f);
  if Wait=0 then Erase(f);
again:
  inst:=ShellExecute(0,nil,name,args,dir,CmdShow);
  if inst<=32 then begin
   if Wait<>0 then begin
    Erase(f);
    Wait:=0;		{Nie warten, wenn's schiefging}
   end;
   if inst=31 then begin
    ext:=GetFileNameExt(name);
    FillChar(ofn,sizeof(ofn),0);
    Word(ofn.lStructSize):=sizeof(ofn);
    ofn.lpstrFile:=s2;
    s2[0]:=#0;
    ofn.nMaxFile:=sizeof(s2);
    wvsprintf(s1,'Verknüpfung für %s',ext);
    ofn.lpstrTitle:=s1;
    ofn.lpstrFilter:='Programme'#0'*.com;*.exe;*.bat;*.pif'#0;
    if GetOpenFileName(ofn) then begin
     wvsprintf(s1,'%s\shell\open\command',ext);
     lstrcat(s2,' %1');
     if RegSetValue(HKEY_Classes_Root,s1,REG_SZ,s2,0)=ERROR_SUCCESS
     then goto again;
    end;
   end else begin
    wvsprintf(s1,'Kann ShellExecute nicht ausführen, Fehler Code %d',inst);
    MessageBox(0,s1,'StartRun',MB_OK or MB_IconStop);
   end;
   exit;
  end;
  if Wait=0 then exit;
  WaitInst:=inst;
 end;

var
 Task: THandle;
{$S-}
function NotifyCallback(wID:Word; dwData:LongInt):Bool; far;
 var
  TE: TTaskEntry;
 begin
  asm push ds; mov ax,seg @data; mov ds,ax end;
  if wID=NFY_ExitTask then begin
   TE.dwSize:=sizeof(TE);
   TaskFindHandle(@TE,GetCurrentTask);
   if TE.hTaskParent=Task then PostAppMessage(Task,WM_User,TE.hInst,dwData);
  end;
  NotifyCallback:=false;
  asm pop ds end;
 end;

var
 Msg:TMsg;
 f: File;

begin
 if HPrevInst<>0 then begin
  PostAppMessage(MemW[HPrevInst:Ofs(Task)],WM_Quit,0,0);
  exit;
 end;
 GetTempFileName(#0,'',0,IniName);	{benutzt TEMP-Umgebungsvariable}
 Assign(f,IniName); Erase(f);
 lstrcpy(GetFileNamePtr(IniName),'START.RUN');
 Assign(f,IniName); Erase(f);		{Nicht mit Leichen starten!}
 Task:=GetCurrentTask;
 NotifyRegister(Task,NotifyCallback,NF_Normal);
 SetTimer(0,0,250,@TimerProc);
 while GetMessage(Msg,0,0,0) do begin
  if (Msg.message=WM_User) and (Msg.wParam=WaitInst) then begin
   WaitInst:=0;
   Assign(f,IniName); Erase(f);
   continue;
  end;
  DispatchMessage(Msg);
 end;
 NotifyUnregister(Task);
 Assign(f,IniName);
 Erase(f);		{Keine Leichen hinterlassen!}
 MessageBox(0,'Programm beendet','StartRun',0);
end.