MyForm[a_Real] := 
        Module[{}, Evaluate[NumberForm[N[a], {Infinity, 4}]]];
MyForm[a_Integer] := Module[{}, a];
MyForm[a_Symbol] := Module[{}, a];
MyForm[a_String] := Module[{}, a];
MyForm[a_StringForm] := Module[{}, a];
MyForm[a_DirectedInfinity] := Module[{}, a];
MyForm[a_List] := Module[{}, Short[a]];
\(\(\(SystemTable[b_List, rahmen_, trennlinie_] := 
        Module[{}, 
          FrameBox[
              GridBox[Map[MyForm, b, {2}], 
                RowLines -> {trennlinie, False}, 
                ColumnLines -> {trennlinie, False, False}, 
                ColumnAlignments -> {Left, Left}], 
              BoxFrame -> rahmen] // DisplayForm];\)\(
\)
    \)\)
\(\(\(SystemList\  = \ {
{"Eigenschaft", "Wert"}, 
{"Betriebsystem", $System}, 
{"Computertyp", $MachineType}, 
{"Prozessortyp", $ProcessorType}, 
{"Maschinenpräzision", $MachinePrecision}, 
{"Max. Präzision", $MaxPrecision}, 
{"Benutzerverzeichnis", $PreferencesDirectory}, 
{"Prozess-Identnummer", $ProcessID}, 
{"Ausgabe erfolgt nach", $Display}
};\)\(
\)
    \)\)
\(\(\(LicenseList\  = \ {
{"Eigenschaft", "Wert"}, 
{"Lizenznummer", $LicenseID}, 
{"MathID", $MachineID}, 
{"Passwort-Datei", $PasswordFile}, 
{"Netzwerklizenz?", 
            If[$NetworkLicense, "Ja", "Nein"]}, 
{"Ablaufdatum der Lizenz", 
            StringForm["`3`.`2`.`1`", $LicenseExpirationDate[\([1]\)], $LicenseExpirationDate[\([2]\)], $LicenseExpirationDate[\([3]\)]]}, 
{"Mathematica-Version", "V " <> 
              ToString[$VersionNumber] <> "." <> 
              ToString[$ReleaseNumber]}, 
{"Mathematica-Installationsdatum", 
            StringForm["`3`.`2`.`1`", $InstallationDate[\([1]\)], $InstallationDate[\([2]\)], $InstallationDate[\([3]\)]]}, 
{"Name des Lizenzservers", $LicenseServer}, 
{"Max. Mathematica Prozesse", $MaxLicenseProcesses}
};\)\(
\)
    \)\)
obj = NotebookCreate[];
\(\(\(NotebookWrite[obj, 
        Cell["Machinenspezifische Informationen", "Section"]];\)\(
\)
    \)\)
NotebookWrite[obj, "SystemTable[SystemList,5,2]"];
SelectionMove[obj, Next, Cell];
SelectionMove[obj, Previous, Cell];
SelectionEvaluate[obj];
\(\(NotebookWrite[obj, 
        Cell[TextData[{StyleBox["Mathematica", 
                FontSlant -> "Italic"], " Informationen"}], "Section"]];\)\)
NotebookWrite[obj, "SystemTable[LicenseList,5,2]"];
SelectionMove[obj, Next, Cell];
SelectionMove[obj, Previous, Cell];
SelectionEvaluate[obj];
SelectionMove[obj, Next, Cell];