'#################################
'System-Informationen mit Profan 7
'#################################
'Andreas Miethe * Februar 2001
'#################################
'Freeware
'#################################

'--------------------------------------
'Definitionen
'--------------------------------------
'
'--------------------------------------
'Konstanten
'--------------------------------------
DEF &Ver_Platform_Win32_Windows 1
DEF &Ver_Platform_Win32_NT 2
'--------------------------------------
'
'--------------------------------------
'Strukturen
'--------------------------------------
'Struktur fuer GetVersionEx()
Struct OSVERSIONINFO = dwOSVersionInfoSize&,dwMajorVersion&,dwMinorVersion&,\
                       dwBuildNumber&,dwPlatformId&,szCSDVersion$(128)

'--------------------------------------
'Globale Variablen
'--------------------------------------
Declare OS#
'
'--------------------------------------
'Prozeduren
'--------------------------------------
'
Proc GetOSInfo
'Windows-Version ermitteln
Declare Ret&,Winver$
Dim OS#,OSVERSIONINFO
OS#.dwOSVersionInfoSize& = 148
Ret& = External("Kernel32","GetVersionExA",OS#)
If OS#.dwPlatformId& = &Ver_Platform_Win32_Windows
        If OS#.dwMajorVersion& = 4
                Case OS#.dwMinorVersion& = 0  : Winver$ = "Windows 95"
                Case OS#.dwMinorVersion& = 10 : Winver$ = "Windows 98"
                Case OS#.dwMinorVersion& = 90 : Winver$ = "Windows ME"
        Endif
ElseIf OS#.dwPlatformId& = &Ver_Platform_Win32_NT
        Case OS#.dwMajorVersion& = 4 : Winver$ = "Windows NT 4"
        Case OS#.dwMajorVersion& = 5 : Winver$ = "Windows 2000"
Endif
Dispose OS#
Return Winver$
EndProc

Proc GetUserNames
'User-Namen ermitteln
Declare Ret$,Buf&
Buf& = 260          'Puffergroesse
Ret$ = Space$(Buf&) 'Puffer mit Leerzeichen fuellen
External("Advapi32","GetUserNameA",Addr(Ret$),Addr(Buf&))
Ret$ = Trim$(Ret$)
Return Ret$
EndProc

Proc GetComputerNames
'Computer-Namen ermitteln
Declare Ret$,Buf&
Buf& = 260          'Puffergroesse
Ret$ = Space$(Buf&) 'Puffer mit Leerzeichen fuellen
External("Kernel32","GetComputerNameA",Addr(Ret$),Addr(Buf&))
Ret$ = Trim$(Ret$)
Return Ret$
EndProc

Proc MakeInfString
'String fuer die Messagebox zusammenstellen
Declare OSVer$,Username$,Computername$
Declare InfStr$
GetOSInfo
OSVer$ = @$(0) 'Betriebssystem
GetUserNames
Username$ = @$(0) ' Username
GetComputerNames
Computername$ = @$(0) ' Computername
InfStr$ = "Betriebsystem : " + OSVer$ + Chr$(13)
InfStr$ = InfStr$ + "Username : " + Username$ + Chr$(13)
InfStr$ = InfStr$ + "Computername : " + Computername$ + Chr$(13)
Return InfStr$
EndProc
'
'--------------------------------------
'Hauptprogramm
'--------------------------------------
'
MakeInfString
Messagebox(@$(0),"Info...",0)
'--------------------------------------
End