unit exestart;
{Statische Bibliothek fr 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-Prfung muá sptestens 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;
{Rckruf 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; {Prfsumme, Summe der Bytes von Offset 002..170}
Title: array[0..29] of Char; {Titel, mit Leerzeichen aufgefllt}
rsv020: Word; {=$0080}
ReqConvK: Word; {Erforderlicher konventioneller Speicher}
ExeFile: array[0..62] of Char; {Ausfhrbarer 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 Vordergrundprioritt}
PriBack: Word; {=$0032 Hintergrundprioritt}
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. Lsung:
* Single-Instance-Application
- "mov ds,seg @data"
- "export" ist sinnlos, es gengt "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 fr 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 fr 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 knnte vor(!) der Rckkehr von WinExec()
aufgerufen werden! Dann wrde 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 fr 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 fr 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 fr 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 Prioritten}
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.
Detected encoding: UTF-8 | 0
|