Stars of Shareware: Programmierung/SOURCE.mdf/programm/windows/pascal/mystub/mystub.pas

Pascal/Delphi Source File | 1994-09-18 | 5.1 KB | 180 lines

(********************************************************************
 PROGRAMNAME=MyStub
 FILETYPE=Program
 LANGUAGE=Turbo Pascal/Borland Pascal
 VERSION=1.00
 DATE=17-Sep-1994
 AUTHOR=Stefan Sperling ([e-mail])
 PURPOSE=Neuer erweiterter Stub für Windows-Programme
 COMPILER=Borland Pascal 7.0
 ********************************************************************
 MyStub dient als neuer erweiterter Stub für Windows-Programme.
 Funktionen:
    1. unter DOS: Hinweistext mit optionalem Aufstart von Windows
       plus der Windows-Anwendung
    2. unter Windows: ist MyStub nicht sichtbar (wird nicht aus-
       geführt)
    3. in einer Windows-DOS-Box: Hinweistext, daß die Anwendung
       in dieser Umgebung nicht gestartet werden kann. Hinweistext,
       wie die Windows-Anwendung in Windows gestartet werden kann.

 MyStub kann idR den Std-Stub ersetzen; in TurboPascal für Windows/
 Borland-Pascal kann das Tool GLUE verwendet werden, um den neuen
 Stub zu setzen.
 ********************************************************************)

{$B-;E-;I-;M 10000,16000;S-;V-;X+}

program MyStub;

uses
    Crt, Dos, Strings, Token;

const
    CRLF = #13#10;
    MinDosVersion = $030A;
    WinDir = 'windir';
    PressKeyMsg = CRLF + 'EINGABETASTE drücken, um zu beenden.';
    TopLine: PChar = '╔════════════════════════════════════════════════════════════════════════════╗';
    BottomLine: PChar = '╚════════════════════════════════════════════════════════════════════════════╝';
    SideFrameChar: PChar = '║';
    WinErrorMsg = '*** Windows läuft!' + CRLF +
                  '    Beenden Sie Windows, bevor Sie SICHDEL erneut starten.';

(* testet, ob Windows aktiv ist *)
function WindowsIsRunning: boolean;
var
   i: integer;
   EnvString: string;
begin
     WindowsIsRunning := false;

     for i:=1 to EnvCount do
     begin
          EnvString := EnvStr(i);
          if Pos(WinDir, EnvString) > 0 then
             WindowsIsRunning := true;
     end;
end;

(* testet, ob min. DOS 3.1 geladen hat *)
function ProperDosVersion: boolean;
var
   DosVer: Integer;
begin
     DosVer := DosVersion;
     DosVer := Swap(DosVer);
     ProperDosVersion := (DosVer >= MinDosVersion);
end;

(* gibt Tasten-Drück-Meldung aus, wartet auf Tastendruck und
   beendet dann. *)
procedure WaitForKeyThenQuit(err: integer);
begin
     WriteLn(PressKeyMsg);
     ReadLn;
     Halt(err);
end;

(* gibt eine Textzeile mit Rahmen aus *)
procedure FramedTextline(Text: String);
begin
    Write(SideFrameChar);
    Write(Text);
    GotoXY(78, WhereY);
    WriteLn(SideFrameChar);
end;

(* akzeptiert nur die Tasteneingabe J oder N; gibt bei J true zurück *)
function FrageJN: boolean;
var
    key: char;
begin
    while KeyPressed do;
    repeat
        key := UpCase(ReadKey);
    until (key = 'J') or (key = 'N');
    Write(key);
    FrageJN := (key = 'J');
end;

(* ruft WIN.COM mit allen Pfaden aus - lt. MS muß der Windows-Pfad
   im DOS-Pfad eingetragen sein, so daß die Suche im akt. Verz.
   nicht nötig ist! *)
function ExecWindows (Param: String): Integer;
var
    DosErr: Integer;
    Tok: TStrTok;
    OnePath: String[40];
begin
    Tok.Init(GetEnv('PATH'));
    OnePath := Tok.NextToken(';');
    DosErr := 1;
    while (OnePath <> '') and (DosErr <> 0) do
    begin
        Exec(OnePath + '\win.com', Param);
        DosErr := DosError;
        OnePath := Tok.NextToken(';');
    end;
    Tok.Done;
    ExecWindows := DosErr;
end;

var
    Modulename: NameStr;    (* Name der EXE ohne Pfad und Extension *)
    Dir: DirStr;
    Ext: ExtStr;
    ErrCode: Integer;

begin
    if WindowsIsRunning then
    begin
        WriteLn('Bitte starten Sie diese Windows-Anwendung nicht innerhalb');
        WriteLn('einer Windows-DOS-Box!');
        WriteLn;
        WriteLn('Um dieses Programm in Windows zu starten, wechseln Sie bitte');
        WriteLn('in Ihren Programm-Manager und wählen Sie dort den Menübefehl');
        WriteLn('''Datei->Ausführen''. Geben Sie ', ParamStr(0), ' als');
        WriteLn('Programm-Name an.');
        WaitForKeyThenQuit(3);
    end;

    FSplit(ParamStr(0), Dir, Modulename, Ext);
    WriteLn(TopLine);
    FramedTextline('HINWEIS!');
    FramedTextline('');
    FramedTextline(Modulename + ' ist eine Windows-Anwendung und muß deswegen unter der');
    FramedTextline('graphischen Oberfläche von Microsoft(tm) Windows(tm), Version 3.1 oder');
    FramedTextline('höher, ausgeführt werden!');
    WriteLn(BottomLine);

    if not ProperDosVersion then
    begin
        WriteLn;
        WriteLn('Leider befindet sich auf Ihrem Rechner eine zu alte DOS-Version,');
        WriteLn('um Microsoft(tm) Windows(tm) 3.1 oder höher ausführen zu können.');
        WriteLn;
        WriteLn('Sie benötigen MS-DOS(tm) Version 3.1 oder höher, um Microsoft(tm)');
        WriteLn('Windows(tm) 3.1 ausführen zu können. Bitte besorgen Sie sich ein Update.');
        WriteLn;
        WriteLn('Schade eigentlich...');
    end else begin
        WriteLn('Soll Microsoft(tm) Windows(tm) jetzt gestartet werden,');
        Write('um ', Modulename, ' auszuführen? (J/N) ');
        if FrageJN then
        begin
            WriteLn;
            WriteLn('OK - starte win ', ParamStr(0), '...');
            SwapVectors;
            ErrCode := ExecWindows(ParamStr(0));
            SwapVectors;
            WriteLn;

            if ErrCode <> 0 then
            begin
                WriteLn('*** DOS lieferte Fehler Nr. ', ErrCode);
                Halt(4);
            end;
        end;
    end;
end.