Quelltext /~heha/hs/autorun.zip/LEXIROM1/src/exestart.pas

unit exestart;
{Statische Bibliothek für das Erfassen des Programmendes bei WinExec}
{$C MOVEABLE PRELOAD PERMANENT}	{gleiche Attribute wie Unit SYSTEM}
{$F-,A+,G+,K+,W-}
{$I-,Q-,R-,S-}	{Stack-Prüfung muß spätestens bei Hook-Funktion aus sein!}
{$V+,B-,X+,T+,P+}

{Definiert die Funktionen ExecAndWait, SetExeTermNotify und CreatePif}
interface
uses WinProcs,WinTypes;

{MessageBox-Funktionen auf Basis von unterteilten Ressourcen-Strings}
function ExecAndWait(CmdLine:PChar; CmdShow:Word; Wnd:HWnd):Word;
{liefert um $4000 verschobenes WinExec-Resultat bei Fehler,
 sonst Exitcode (im wesentlichen: LoByte auswerten!) des Programms}
function SetExeTermNotify(Wnd: HWnd; Msg:Word):Bool;
{Rückruf erfolgt mit PostMessage, wParam=Child-Instanz und lParam=Exit-Code.
 Aufruf mit Wnd<>0 schaltet Callback ein, Wnd=0 schaltet Callback aus.
 Kann nicht verschachtelt werden!}

{Zip/Unzip-Hilfe - Start von unsichtbaren DOS-Boxen}
type
 TPIF=record
  rsv000: Byte;		{=$00}
  Checksum: Byte;	{Prüfsumme, Summe der Bytes von Offset 002..170}
  Title: array[0..29] of Char;	{Titel, mit Leerzeichen aufgefüllt}
  rsv020: Word;		{=$0080}
  ReqConvK: Word;	{Erforderlicher konventioneller Speicher}
  ExeFile: array[0..62] of Char; {Ausführbarer Dateiname, nullterminiert,
			 MIT PFAD & ENDUNG!}
  SmFlag1: Word;	{=$0010,
			{ Bit4=Fenster schließen beim Beenden}
			{ Bit}
  WorkDir: array[0..63] of Char; {Arbeitsverzeichnis, nullterminiert}
  SMParams: array[0..63] of Char; {Programm-Parameter, nullterminiert, Standard Mode}
  rsv0E5: Word;		{=$0100}
  rsv0E7: Word;		{=$FF00}
  rsv0E9: Word;		{=$5019}
  rsv0EB: Word;		{=$0000}
  SmFlag2: Word;	{=$0007}
			{ Bit4=Grafik/Mehrfachtext}
  rsv0EF: array[0..63] of Word;	{lauter Nullen}
  SmFlag3: Word;	{=$60E0}
{Hier beginnt die Enhanced-Mode-Sektion}
  Magic1: array[0..15] of Char;	{"MICROSOFT PIFEX"}
  rsv181: Word;		{=$0187}
  rsv183: Word;		{=$0000}
  rsv185: Word;		{=$0171}
  Magic2: array[0..15] of Char;	{"WINDOWS 386 3.0"}
  rsv197: Word;		{=$0205}
  rsv199: Word;		{=$019D}
  rsv19B: Word;		{=$0068}
  V86MaxK: Word;	{=$0280}
  V86MinK: Word;	{=$0080}
  PriFore: Word;	{=$0064 Vordergrundpriorität}
  PriBack: Word;	{=$0032 Hintergrundpriorität}
  EmsMaxK: Word;	{=$FFFF Max EMS (386Enh)}
  EmsMinK: Word;	{=$0000 Min EMS}
  XmsMaxK: Word;	{=$FFFF Max XMS}
  XmsMinK: Word;	{=$0000 Min XMS}
  InfoShell: LongInt;	{=$00025002}
  InfoVDD: LongInt;	{=$0000001F}
  VKD_ScanCode: Word;	{=$0000}
  VKD_Mask: LongInt;	{=$00000000}
  rsv1BB: array[0..4] of Word;	{lauter Nullen}
  EMParams: array[0..63] of Char; {Programm-Parameter, nullterminiert, Enhanced Mode}
{Hier beginnt die Standard-Mode-Erweiterung}
  Magic3: array[0..15]of Char;	{"WINDOWS 286 3.0"}
  rsv215: Word;		{=$FFFF}
  rsv217: Word;		{=$021B}
  rsv219: Word;		{=$0006}
  SmXmsMaxK: Word;	{=$FFFF Max XMS}
  SmXmsMinK: Word;	{=$0000 Min XMS}
  SmFlag4: Word;	{=$0000}
 end;
{***************
;VDD PIF_State service definitions
;
; These definitions cannot change without changing the PIF editor!!!
;}
const
 fVidTxtEmulate	= $00000001;	{ Do INT 10h TTY and cursor emulation}
 fVidNoTrpTxt	= $00000002;	{ Do not trap text mode apps}
 fVidNoTrpLRGrfx= $00000004;	{ Do not trap lo res graphics mode apps}
 fVidNoTrpHRGrfx= $00000008;	{ Do not trap hi res graphics mode apps}
 fVidTextMd	= $00000010;	{ Allocate text mode mem}
 fVidLowRsGrfxMd= $00000020;	{ Allocate lo res graphics mode mem}
 fVidHghRsGrfxMd= $00000040;	{ Allocate hi res graphics mode mem}
 fVidRetainAllo	= $00000080;	{ Never deallocate once allocated}

{
 Bits of returned EAX flags for SHELL_GetVMInfo service
}
{ SGVMI_Windowed	  = $00000004 { Is Windowed}
 VMI_CloseOnExit  = $00000001;
 VMI_RunBackground= $00000002;
 VMI_RunExclusive = $00000004;
 VMI_RunFullscreen= $00000008;

 SGVMI_ALTTABdis  = $00000020; { Alt+Tab is reserved}
 SGVMI_ALTESCdis  = $00000040; { Alt+Esc is reserved}
 SGVMI_ALTSPACEdis= $00000080; { Alt+Space is reserved}
 SGVMI_ALTENTERdis= $00000100; { Alt+Enter is reserved}
 SGVMI_ALTPRTSCdis= $00000200; { Alt+PrtSc is reserved}
 SGVMI_PRTSCdis	  = $00000400; { PrtSc is reserved}
 SGVMI_CTRLESCdis = $00000800; { Ctrl+Esc is reserved}
 SGVMI_Polling	  = $00001000; { Polling detection Enab}
 SGVMI_NoHMA	  = $00002000; { No HMA}
 SGVMI_HasHotKey  = $00004000; { Has a shortcut key}
 SGVMI_EMS_Lock	  = $00008000; { EMS Hands Locked}
 SGVMI_XMS_Lock	  = $00010000; { XMS Hands Locked}
 SGVMI_FastPaste  = $00020000; { Allow Fast paste Enab}
 SGVMI_V86_Lock	  = $00040000; { V86 Memory Locked}

 VKD_ShiftMask	= $000F0003;
 VKD_CtrlMask	= $000F0004;
 VKD_AltMask	= $000F0008;

 F1_GraphicsSave= $0002;
 F1_NoTaskswitch= $0004;
 F1_NoPRTSC	= $0008;
 F1_CloseOnExit	= $0010;
 F1_COM2_Lock	= $0040;
 F1_COM1_Lock	= $0080;

 F2_Default	= $0007;
 F2_GraphicsSave= $0010;

 F3_Default	= $60E0;
 F3_Modify_Kbd	= $0010;

 F4_ALTTABdis	= $0001;
 F4_ALTESCdis	= $0002;
 F4_ALTPRTSCdis	= $0004;
 F4_PRTSCdis	= $0008;
 F4_CTRLESCdis	= $0010;
 F4_COM3_Lock	= $4000;
 F4_COM4_Lock	= $8000;

procedure CreatePIF(Title,ExeFile,Params,WorkDir:PChar;
  var PIF:TPif);
{WorkDir ist das TEMP-Verzeichnis, wenn NIL}
{FileName liefert(!) den Dateinamen im TEMP-Verzeichnis, falls leer}
{Title kann eine String-Ressource-ID sein: mit MakeIntResource() übergeben!}

implementation
uses Win31,ToolHelp,WUtils;

var
 ProcInst: TFarProc;
 ThisTask: THandle;
 ChildInst: THandle;
const
 NotifyWnd: HWnd=0;
 Blocked: Boolean=false;
 Hooked: Boolean=false;
var
 NotifyMsg: Word;

function NotifyCallback(ID:Word; Data:LongInt):Bool; far;
{Achtung! Smart Callback funktioniert hier NICHT!
 Toolhelp ruft diese Funktion, ohne das SS-Register aufs Datensegment
 zu setzen, leider. Lösung:
 * Single-Instance-Application
   - "mov ds,seg @data"
   - "export" ist sinnlos, es genügt "far"; dann muß DS gerettet werden
 * Multiple-Instance-Application
   - Verwendung von MakeProcInstance() und FreeProcInstance() erforderlich
   - $K- schalten oder (da dieser Schalter leider global ist)
   - "export" durch "far" ersetzen und am Eintritt den Assemblerbefehl
     "mov ds,ax" setzen. Nicht vergessen, DS zu retten}
{** NICHT OK für DLL **}
 var
  TE: TTaskEntry;
 begin
  asm	push	ds
	mov	ds,ax
  end;
  if ID=NFY_ExitTask then begin
   TE.dwSize:=sizeof(TE);
   TaskFindHandle(@TE,GetCurrentTask);
   if TE.hTaskParent=ThisTask then begin
    if Blocked and (TE.hInst=ChildInst) then begin
     ChildInst:=LongRec(Data).Lo;	{Returncode}
     if not PostAppMessage(TE.hTaskParent,WM_ParentNotify,0,Data)
     then Blocked:=false;
    end else if NotifyWnd<>0
    then PostMessage(NotifyWnd,NotifyMsg,TE.hInst,Data);
   end;
  end;
  NotifyCallback:=false;
  asm pop ds end;
 end;

function ExecAndWait(CmdLine:PChar; CmdShow:Word; Wnd:HWnd):Word;
{** NICHT OK für DLL **}
 var
  OldWndCurs:HCursor;
  Msg: TMsg;
  th: Word;
 begin
  if not Hooked then begin
   ProcInst:=MakeProcInstance(@NotifyCallback,Seg(HInstance));
   NotifyRegister(0,TNotifyCallback(ProcInst),NF_Normal);
   ThisTask:=GetCurrentTask;
   Hooked:=true;
  end;
  if Wnd<>0 then OldWndCurs:=SetClassWord(Wnd,GCW_HCursor,LoadCursor(0,IDC_Wait));
  ChildInst:=WinExec(CmdLine,CmdShow);
{Problem: Callback könnte vor(!) der Rückkehr von WinExec()
 aufgerufen werden! Dann würde ExecAndWait() ewig warten}
  if ChildInst>32 then begin
   Blocked:=true;
   if Wnd<>0 then EnableWindow(Wnd,false);	{Keine Tastatur, keine Maus!}
   th:=0;
   if GetWinFlags and WF_WinNT <>0
   then th:=SetTimer(0,0,1000,nil);
   while Blocked do begin
    GetMessage(Msg,0,0,0);
    if (Msg.hwnd=0) and (Msg.message=WM_ParentNotify)
    then blocked:=false
    else DispatchMessage(Msg);
   end;
   if th<>0 then KillTimer(0,th);
   if Wnd<>0 then EnableWindow(Wnd,true);
  end else Inc(ChildInst,$4000);{Fehlercode-Offset bei Fehler dazu}
  if Wnd<>0 then SetClassWord(Wnd,GCW_HCursor,OldWndCurs);
  if Hooked then begin
   NotifyUnregister(0);
   FreeProcInstance(ProcInst);
   Hooked:=false;
  end;
  ExecAndWait:=ChildInst;	{0 wenn erfolgreich}
 end;

function SetExeTermNotify(Wnd: HWnd; Msg:Word):Bool;
{** NICHT OK für DLL **}
 begin
  SetExeTermNotify:=true;
  if Wnd<>0 then begin
   if not Hooked then begin
    ProcInst:=MakeProcInstance(@NotifyCallback,Seg(HInstance));
    SetExeTermNotify:=NotifyRegister(0,TNotifyCallback(ProcInst),NF_Normal);
    ThisTask:=GetCurrentTask;
    Hooked:=true;
   end;
  end else begin
   if Hooked then begin
    NotifyUnregister(0);
    FreeProcInstance(ProcInst);
    Hooked:=false;
   end;
  end;
  NotifyWnd:=Wnd;
  NotifyMsg:=Msg;
 end;

procedure ShortYield;
{** OK für DLL **}
 var
  Msg: TMsg;
 begin
  if PeekMessage(Msg,0,0,0,PM_Remove) then begin
   TranslateMessage(Msg);
   DispatchMessage(Msg);
  end;
 end;

procedure CreatePIF(Title,ExeFile,Params,WorkDir:PChar;
  var PIF:TPif);
{** NICHT OK für DLL **}
const
 APIF:TPIF=(
  rsv000:	$00;
  Checksum:	$00;
  Title:	'(No Title)                    ';
  rsv020:	$0080;
  ReqConvK:	$0080;
  ExeFile:	'%COMSPEC%';
  SmFlag1:	$0010;
  WorkDir:	'';
  SMParams:	'';
  rsv0E5:	$0100;
  rsv0E7:	$FF00;
  rsv0E9:	$5019;
  rsv0EB:	$0000;
  SmFlag2:	$0007;
  rsv0EF:(	0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
		0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
  SmFlag3:	$60E0;
  Magic1:	'MICROSOFT PIFEX'#0;
  rsv181:	$0187;
  rsv183:	$0000;
  rsv185:	$0171;
  Magic2:	'WINDOWS 386 3.0'#0;
  rsv197:	$0205;
  rsv199:	$019D;
  rsv19B:	$0068;
  V86MaxK:	$0280;
  V86MinK:	$0080;
  PriFore:	$0400;		{Hohe Prioritäten}
  PriBack:	$0400;
  EmsMaxK:	$FFFF;
  EmsMinK:	$0000;
  XmsMaxK:	$FFFF;
  XmsMinK:	$0000;
  InfoShell:	$00025002;	{im Fenster! (sonst wirkt SW_Hide nicht)}
  InfoVDD:	$0000001F;
  VKD_ScanCode:	$0000;
  VKD_Mask:	$00000000;
  rsv1BB:(	0,0,0,0,0);
  EMParams:	'';
  Magic3:	'WINDOWS 286 3.0'#0;
  rsv215:	$FFFF;
  rsv217:	$021B;
  rsv219:	$0006;
  SmXmsMaxK:	$FFFF;
  SmXmsMinK:	$0000;
  SmFlag4:	$0000);
 begin
  Pif:=APif;			{Struktur kopieren}
  if LongRec(Title).Hi<>0 then begin
   lstrcpyn(Pif.Title,Title,sizeof(Pif.Title)-1);
   (Pif.Title+lstrlen(Pif.Title))^:=' ';	{"blank padded"}
  end else if LongRec(Title).Lo<>0 then begin
   (Pif.Title+LoadString(Seg(HInstance),LongRec(Title).Lo,
     Pif.Title,sizeof(Pif.Title)-1))^:=' ';
  end;
  if ExeFile<>nil
  then lstrcpyn(Pif.ExeFile,ExeFile,sizeof(Pif.ExeFile)-1);
  if Params<>nil then begin
   lstrcpyn(Pif.SMParams,Params,sizeof(Pif.SMParams)-1);
   lstrcpyn(Pif.EMParams,Params,sizeof(Pif.EMParams)-1);
  end;
  if WorkDir<>nil
  then lstrcpyn(Pif.WorkDir,WorkDir,sizeof(Pif.WorkDir)-1);
 end;

end.
Vorgefundene Kodierung: OEM (CP437)1
Umlaute falsch? - Datei sei ANSI-kodiert (CP1252)