Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
176to180
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
176to180
176to180
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Daten des PC's auslesen

Daten des PC's auslesen
03.11.2002 19:24:43
Benedikt
Hi Leute,

ich will mal eine Art Registrierung, wie sie in Win XP existiert, in Excel nachbauen. Derjenige, der mein Programm startet, soll nur Zugriff auf das Arbeitsblatt erhalten, wenn eine aus seinen PC-Komponenten gebildete Nummer mit einer von mir vorgegebenen übereinstimmt. Das Problem: Wie komme ich über Excel an Daten wie z.B. Taktzahl des Prozessors, Name des PC's oder Größe des Arbeitsspeichers ran? Noch eine Frage: Gibt es überhaupt eine Nummer, die jeden PC eindeutig identifiziert, wie z.B. eine Prozessornummer (aber die wurde ja wieder abgeschafft, nachdem Intel nicht damit durchgekommen ist)?

mfg

Benedikt

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Re: Daten des PC's auslesen
03.11.2002 20:19:00
josef
hi benedikt,

hab dir mal einige codes als ansatz gemailt

gruß
josef

Re: Daten des PC's auslesen
03.11.2002 20:31:45
PeterW
Hallo Josef,

vielleicht hätten ja auch andere Leser hier Interesse an Deinen Ansätzen.

Gruß
Peter

sorry
03.11.2002 20:36:55
josef
sorry erstmal. natürlich hier nochmal für alle:


benutzername ausgeben:

Declare Function GetUserName Lib "advapi32.dll" _
Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Sub ShowUserName()
Dim Buffer As String * 100
Dim BuffLen As Long
BuffLen = 100
GetUserName Buffer, BuffLen
MsgBox Left(Buffer, BuffLen - 1)
End Sub


arbeitsspeicher:


Option Explicit

Private Type MEMORYSTATUS
dwLength As Long
dwMemoryLoad As Long
dwTotalPhys As Long
dwAvailPhys As Long
dwTotalPageFile As Long
dwAvailPageFile As Long
dwTotalVirtual As Long
dwAvailVirtual As Long
End Type

Private Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As MEMORYSTATUS)

Private Sub Memory()
Dim MemStat As MEMORYSTATUS
GlobalMemoryStatus MemStat
MsgBox "belegter Speicher (in %): " & _
Format(Str$(MemStat.dwMemoryLoad), "#,##0") & _
vbLf & "Speicher insgesamt: " & _
Format(Str$(MemStat.dwTotalPhys / 1024), "#,##0") & " Kb;" & _
vbLf & "davon verfügbar: " & _
Format(Str$(MemStat.dwAvailPhys / 1024), "#,##0") & " Kb;" & _
vbLf & "in gepageten Dateien: " & _
Format(Str$(MemStat.dwTotalPageFile / 1024), "#,##0") & " KB;" & _
vbLf & "davon noch frei: " & _
Format(Str$(MemStat.dwAvailPageFile / 1024), "#,##0") & " KB;" & _
vbLf & "virtueller Speicher: " & _
Format(Str$(MemStat.dwTotalVirtual / 1024), "#,##0") & " KB;" & _
vbLf & "davon verfügbar: " & _
Format(Str$(MemStat.dwAvailVirtual / 1024), "#,##0") & " KB;"
End Sub

noch ein paar sachen (drucker)

Public Sub aktiven_drucker_auslesen()

MsgBox Application.ActivePrinter

' zeigt den aktiven drucker der geöffneten datei

End Sub

Public Sub alle_drucker_auslesen()

Application.Dialogs(xlDialogPrinterSetup).Show

' nach bedarf einen drucker auswählen, doppelclick ausführen,
' dann ist der angewählte drucker der aktive drucker für die geöffnete datei!

End Sub



Anzeige
Danke o.T.
03.11.2002 20:40:49
PeterW

nachtrag: alle verfügbaren laufwerke finden
03.11.2002 20:51:59
josef
hier noch ein nachtrag. damit kann man alle auf dem lokalen pc verfügbaren laufwerke erfahren:

Sub ShowDriveList()
'On Error Resume Next
Dim fs, d, dc, s, n
Set fs = CreateObject("Scripting.FileSystemObject")
Set dc = fs.Drives
For Each d In dc
s = s & d.DriveLetter
If d.DriveType = 3 Then
n = d.ShareName
'Else
' n = d.VolumeName
End If
s = s & n & vbCrLf
Next
MsgBox s
End Sub



Re: Daten des PC's auslesen
04.11.2002 11:53:43
Kai
Declare Function GetVolumeInformationA Lib "kernel32" _
(ByVal lpRootPathName As String, _
ByVal lpVolumeNameBuffer As String, _
ByVal nVolumeNameSize As Long, _
lpVolumeSerialNumber As Long, _
lpMaximumComponentLength As Long, _
lpFileSystemFlags As Long, _
ByVal lpFileSystemNameBuffer As String, _
ByVal nFileSystemNameSize As Long) As Long
'*************************
Public sub test
GetVolumeInformationA "C:\", vbNullString, 0, SerialNumber, _
0, 0, vbNullString, 0
If SerialNumber <> -12073 Then Application.Quit
end sub

Die Abfrage der Seriennummer der Platte scheint für Dein Problem
auch ein Ansatz zu sein.

Gruß Kai

Anzeige
Danke!!!
04.11.2002 19:57:26
Benedikt
Danke!!! Das ging ja echt schnell!
Die Seriennummer der Platte scheint mir der passende Ansatz zu sein! Danke für den Tip!

Benedikt

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige