Hallo,
seit knapp drei Stunden suche ich den Fehler in folgendem Code:
Die Form mit Textbox, Label und Timer:
’ Variablen deklarieren
Option Explicit
Private Aktion As Boolean, Mausposition_X As Single, Mausposition_Y As Single, Mausbewegung As Boolean, Username As String
Private Sub Form_KeyPress(KeyAscii As Integer)
’ Wurde eine Taste gedrück Startvorgang vorbereiten
Aktion = True
End Sub
Private Sub Form_Load()
’ Username einlesen
Username = NetUser()
’ Vollbildmodus wählen
With Me
.Top = 0
.Left = 0
.Height = Screen.Height
.Width = Screen.Width
End With
’ Userhinweis
Label1.Caption = „IP-Aktualisierung:“ & Chr(13) & „Systemstatus wird geprüft. Erfolgt keine Eingabe geht das System davon aus, dass Sie gerade nicht an diesem Computer arbeiten. Der Voragnag wird anschließend automatisch durchgeführt. Eine Unterbrechung dieses Vorgangs kann zu einem unvorhersehbaren Fehler führen!“
’ Startvorgang auf die Warteschleife setzen
Aktion = False: Mausbewegung = False
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
’ Wurde eine Taste gedrück Startvorgang vorbereiten
Aktion = True
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
’ Wurde die Maus mehr als 100 bewegt Startvorgang vorbereiten
If Mausbewegung Then
If Abs(X - Mausposition_X) > 100 Then Aktion = True
If Abs(Y - Mausposition_Y) > 100 Then Aktion = True
End If
’ Aktuellen Parameter zur Prüfung übergeben
Mausposition_X = X: Mausposition_Y = Y: Mausbewegung = True
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
’ Wenn die Eingabetaste gedrückt wurde, dann prüfen
If KeyAscii = vbKeyReturn Then
If LCase(Trim(Text1.Text)) = LCase(Trim(Username)) Then
’ Bei einer Übereinstimmung weitermachen
Speicher_Feedback = True: Unload frmUser: Exit Sub
Else
’ Wiederholungsaufforderung ausgeben
Label1.Caption = „IP-Aktualisierung:“ & Chr(13) & „Fehlerhafte Eingabe! Bitte wiederholen Sie Ihre Eingabe:“
With Text1
.SelStart = 0
.SelLength = Len(Text1.Text)
End With
End If
End If
End Sub
Private Sub Timer1_Timer()
’ Startvorgang abfragen
If Not Aktion Then
’ Hat keine Aktion nach 30Sekunden stattgefunden wird der Computer gerade von keinem User genutzt
Speicher_Feedback = True: Unload frmUser
Else
’ Userhinweis
Label1.Caption = „IP-Aktualisierung:“ & Chr(13) & „Es wurde eine Eingabe registriert! Bitte unterbrechen Sie Ihre Arbeit und warten Sie bitte bis der Vorgang beendet ist. Es erfolgt nach dem Abschluss des Vorgangs eine Benachrichtigung.“ & Chr(13) & „Als Einverständniserklärung geben Sie bitte Ihren Username ein:“
’ Username einlesen
If NetUser = „“ Then
’ Wenn niemand angemeldet ist beenden
MsgBox „Bitte melden Sie sich neu an!“, vbOKOnly + vbCritical, „Ausnahmefehler“
End: Exit Sub
Else
’ Textfeld anzeigen
With Text1
.Left = (Screen.Width - Text1.Width) / 2
.Top = (Screen.Height - Text1.Height) / 2
.Text = „Ihr Username“
.SelStart = 0
.SelLength = Len(Text1.Text)
.Visible = True
End With
End If
End If
’ Timer abschalten (war einmaliges zeitabhängiges Ereignis)
Timer1.Enabled = False
End Sub
Das Modul:
’ Variablen deklarieren
Option Explicit
Global Speicher_Feedback As Boolean
Private Declare Function GetUserName Lib „advapi32.dll“ Alias „GetUserNameA“ (ByVal lpBuffer As String, nSize As Long) As Long
Public Function Feedback() As Boolean
’ Prüfungsformular zeigen
frmUser.Show vbModal
’ Ergebnis übergeben
Feedback = Speicher_Feedback
End Function
Public Function NetUser()
’ Variablen deklarieren
Dim s As String, cnt As Long, ret As Long
’ Username auslesen
cnt = 199: s = String$(200, 0): ret = GetUserName(s, cnt)
’ Überprüfen ob überhaupt ein User angemeldet ist
If Not ret = 0 Then NetUser = Left$(s, cnt) Else NetUser = „“
End Function
Feedback wird aus der Main-Form aufgerufen und was dann passiert ist mir in meinen 8 Jahren Programmiererfahrung mit Basic noch nie untergekam: Die If-Abfrage liefert immer falsch. Auch wenn ich an der Stelle an der ich schried .Text=„Ihr Name“ dies durch folgendes ersetze, bleibt der Fehler bestehen: .Text=Username (Username ist kein reservierter Name von VB - wurde schon geprüft) Ich bin verzeifelt! HILFE!!!
Gruß [email protected]
PS: Sorry aber im Eingabeformular hatte ich Tabs drin, die jetzt fehlen (erschwert das Lesen).
