'######################################
'System-Informationen mit Profan 32-Bit
'######################################
'Andreas Miethe * April 2001
'######################################
'Freeware
'######################################

'--------------------------------------
'Definitionen
DEF GetVersion(1) ! "Kernel32","GetVersionExA"
DEF GetUserName(2) ! "Advapi32","GetUserNameA"
DEF GetComputerName(2) ! "Kernel32","GetComputerNameA"

'--------------------------------------
'
'--------------------------------------
'Konstanten
'--------------------------------------
Declare Ver_Platform_Win32_Windows&,Ver_Platform_Win32_NT&
Let Ver_Platform_Win32_Windows& = 1
Let Ver_Platform_Win32_NT& = 2
'--------------------------------------
'
'--------------------------------------
'Globale Variablen
'--------------------------------------
Declare OSVERSIONINFO#
Declare Ret#,Buffer#
'
'--------------------------------------
'Prozeduren
'--------------------------------------
'
Proc GetOSInfo
'Windows-Version ermitteln
Declare Ret&,Winver$
Dim OSVERSIONINFO#,148
Long OSVERSIONINFO#,0 = 148
Let Ret& = GetVersion(OSVERSIONINFO#)
If EQU(Long(OSVERSIONINFO#,16),Ver_Platform_Win32_Windows&)
        If EQU(Long(OSVERSIONINFO#,4),4)
                Case EQU(Long(OSVERSIONINFO#,8),0)  : Let Winver$ = "Windows 95"
                Case EQU(Long(OSVERSIONINFO#,8),10) : Let Winver$ = "Windows 98"
                Case EQU(Long(OSVERSIONINFO#,8),90) : Let Winver$ = "Windows ME"
        Endif
ElseIf EQU(Long(OSVERSIONINFO#,16),Ver_Platform_Win32_NT&)
                Case EQU(Long(OSVERSIONINFO#,4),4) : Let Winver$ = "Windows NT 4"
                Case EQU(Long(OSVERSIONINFO#,4),5) : Let Winver$ = "Windows 2000"
Endif
Dispose OSVERSIONINFO#
Return Winver$
EndProc

Proc GetUserNames
'User-Namen ermitteln
Declare Ret$,Ret#,Buffer&,Buffer#
Let Buffer& =260
Dim Buffer#,4
Dim Ret#,Buffer&
Long Buffer#,0 = Buffer&
GetUserName(Ret#,Buffer#)
Let Ret$ = String$(Ret#,0)
Dispose Ret#
Dispose Buffer#
Return Ret$
EndProc

Proc GetComputerNames
'Computer-Namen ermitteln
Declare Ret$,Ret#,Buffer&,Buffer#
Let Buffer& =260
Dim Buffer#,4
Dim Ret#,Buffer&
Long Buffer#,0 = Buffer&
GetComputerName(Ret#,Buffer#)
Let Ret$ = String$(Ret#,0)
Dispose Ret#
Dispose Buffer#
Return Ret$
EndProc

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