Ich hab' da noch was:
Standard-Drucker ermitteln
Private Declare Function GetProfileString Lib "kernel32" _
Alias "GetProfileStringA" (ByVal lpAppName As String, _
ByVal lpKeyName As String, ByVal lpDefault As String, _
ByVal lpReturnedString As String, ByVal nSize As Long) _
As Long
Private Sub GetStdPrinterName()
Dim PrinterName$, Driver$, Port$
Dim Buffer$, r&, X&, Y&
Buffer = Space(8192)
r = GetProfileString("windows", "Device", "", Buffer, Len(Buffer))
If r Then
Buffer = Mid(Buffer, 1, r)
X = InStr(Buffer, ",")
PrinterName = Mid(Buffer, 1, X - 1)
Y = InStr(X + 1, Buffer, ",")
Driver = Mid(Buffer, X + 1, Y - X - 1)
Port = Mid(Buffer, Y + 1)
Else
PrinterName = "?"
Driver = "?"
Port = "?"
End If
End Sub
oder eine VolumeInformation
Private Declare Function GetVolumeInformation& Lib "kernel32" _
Alias "GetVolumeInformationA" (ByVal lpRootPathName _
As String, ByVal pVolumeNameBuffer As String, ByVal _
nVolumeNameSize As Long, lpVolumeSerialNumber As Long, _
lpMaximumComponentLength As Long, lpFileSystemFlags As _
Long, ByVal lpFileSystemNameBuffer As String, ByVal _
nFileSystemNameSize As Long)
Const MAX_FILENAME_LEN = 256
Public Function SerNum(Drive$) As Long
Dim No&, S As String * MAX_FILENAME_LEN
Call GetVolumeInformation(Drive & ":\", S, MAX_FILENAME_LEN, _
No, 0&, 0&, S, MAX_FILENAME_LEN)
SerNum = No
End Function
CD-Fach öffnen/schließen
Private Declare Function mciExecute Lib "winmm.dll" _
(ByVal lpstrCommand As String) As Long
' Laufwerkstür öffnen
Call mciExecute("Set CDaudio door open")
' Laufwerkstür schließen
Call mciExecute("Set CDaudio door closed")
Dauer seit Anmeldung
Private Declare Function GetTickCount Lib "kernel32" () As Long
Dim H As Single, M As Single, S As Single, MS As Single
Dim strH$, strM$, strS$, strMS$
MS = GetTickCount()
MS = MS / 1000
H = Int(MS / 3600)
MS = MS - H * 3600
M = Int(MS / 60)
MS = MS - M * 60
S = Int(MS)
MS = Int((MS - S) * 10)
strH = CStr(H)
strM = Format(CStr(M), "##00")
strS = Format(CStr(S), "##00")
strMS = CStr(MS)
'lblTime.Caption = strH & ":" & strM & ":" & strS & ":" & strMS
Wie versprochen:
Declare Function InternetGetConnectedState Lib "wininet.dll" (lpSFlags As Long, Byval dwReserved As Long) As Long
Const INTERNET_CONNECTION_LAN = &H2
Const INTERNET_CONNECTION_MODEM = &H1
Const INTERNET_CONNECTION_PROXY = &H4
Const INTERNET_CONNECTION_MODEM_BUSY = &H8
Sub Click(Source As Button)
Dim icFlags As Long
Call InternetGetConnectedState(icFlags, 0&)
Msgbox Out(icFlags, INTERNET_CONNECTION_LAN), 0, "Verbunden via LAN"
Msgbox Out(icFlags, INTERNET_CONNECTION_MODEM), 0, "Verbunden via Modem"
Msgbox Out(icFlags, INTERNET_CONNECTION_PROXY), 0, "Verbunden via Proxy"
Msgbox Out(icFlags, INTERNET_CONNECTION_MODEM_BUSY), 0, "Modem ist gerade aktiv"
End Sub
Function Out(Byval icFlags&, Byval Flag&) As String
If Flag And icFlags Then
Out = "Ja"
Else
Out = "Nein"
End If
End Function