Finde den Fehler nicht -.-

Dieses Thema Finde den Fehler nicht -.- im Forum "Windows XP Forum" wurde erstellt von sp00n, 2. Feb. 2006.

Thema: Finde den Fehler nicht -.- Irgendwie finde ich den fehler in meinem Script nicht... und da dachte ich mir, ich lass euch mal gucken ;) Hier...

  1. Irgendwie finde ich den fehler in meinem Script nicht... und da dachte ich mir, ich lass euch mal gucken ;)

    Hier nochmal was dazu, was das Script eigentlich macht:

    Es wird von einer anderen Form um eine bestimmte uhrzeit geladen..
    Deshalb startet auch alles direkt aus Form_Load und nicht aus nem Button oder so ;)

    Nunja.. das Script erstellt eine Textdatei aus verschiedenen Log-Zusammenschnitten ;) und versendet diesen Text dann per email :)

    Nun zu meinem Problem..
    ..Das Script sendet die Email immer wieder.. und wieder.. und wieder ... .. .. :(

    Und ich find den Fehler nicht.. hier der Code:

    Code:
    Option Explicit
    Dim Mailing As Boolean
    Dim Result As String
    Dim Sec As Integer
    Dim TimeOut As Integer
    Dim oStream As TextStream
    Dim theDrive As Drive
    
    Dim ServerAdd As String
    Dim ServerPort As Integer
    Dim SendName As String
    Dim SendEMail As String
    Dim ReceiverMail As String
    Dim Domain As String
    Dim Login As String
    Dim Pass As String
    Dim Login64 As String
    Dim Pass64 As String
    
    Dim Subject As String
    Dim Mailtext As String
    Dim Sourcetext As String
    
    Dim var_base64
    Dim B64() As Byte
    
    Private Sub Form_Load()
      If GetINI(StatusMail, Status) = 1 Then
        TimeOut = 20
        CreateMsg
        TimerSend.Enabled = True
      Else
        lblMainStatus.ForeColor = &HC0&
        lblMainStatus.Caption = Dienst ist inaktiv
        TimerClose.Enabled = True
      End If
    End Sub
    
    'Wenn Prozess noch läuft und geschlossen wird -> protokolieren
    Private Sub Form_Unload(Cancel As Integer)
      If Mailing = True Then
        ini = WriteLog(StatusMail, CDbl(CDate(Now)), Abbruch durch Benutzer)
      End If
    End Sub
    
    Private Sub TimerClose_Timer()
      Unload Me
      TimerClose.Enabled = False
    End Sub
    
    Private Sub TimerSend_Timer()
      SendmailStart
      TimerSend.Enabled = False
    End Sub
    
    Private Sub TimerSec_Timer()
      Sec = Sec + 1
      DoEvents
    End Sub
    
    Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
      Winsock1.GetData Result
    End Sub
    
    Private Function SendmailStart()
      ServerAdd = GetINI(StatusMail, ServerAdd)
      ServerPort = GetINI(StatusMail, ServerPort)
      SendName = GetINI(StatusMail, SendName)
      SendEMail = GetINI(StatusMail, SendEMail)
      Login = GetINI(StatusMail, Login)
      Pass = GetINI(StatusMail, Pass)
      Domain = gcd.de
      ReceiverMail = GetINI(StatusMail, ReceiverMail)
      Subject = GetINI(StatusMail, Subject)
      
      Set oStream = oFSO.OpenTextFile(.\SendMail.txt, ForReading)
      Mailtext = oStream.ReadAll
      
      var_base64 = ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/
    
     ->Die Austauschtabelle wird in ein Bytearray uebertragen.
      B64() = StrConv(var_base64, vbFromUnicode)
      Login64 = base64_encode(B64(), Login)
      Pass64 = base64_encode(B64(), Pass)
      
      If Mailing = False Then
        If Sendmail Then
          lblMainStatus.ForeColor = &H8000&
          lblMainStatus.Caption = E-Mail erfolgreich versendet
          ini = WriteLog(StatusMail, CDbl(CDate(Now)), E-Mail erfolgreich versendet)
        Else
          lblMainStatus.ForeColor = &HC0&
          lblMainStatus.Caption = Fehler beim Versenden aufgetreten
          ini = WriteLog(StatusMail, CDbl(CDate(Now)), Fehler beim Versenden aufgetreten)
          Exit Function
        End If
      Else
        MsgBox Vorherige E-Mail wird noch gesendet!, vbCritical Or vbOKOnly, Error
      End If
      TimerClose.Enabled = True
    End Function
    
    Private Function Sendmail() As Boolean
      On Error GoTo ERRORMail
      
      If Mailing = True Then Exit Function
      Mailing = True
      Sourcetext = 
    
     ->Wenn keine Verbindung besteht..
      If Winsock1.State = sckClosed Then
        Sourcetext = Sourcetext & From:  & SendName &  < & SendEMail & >
        Sourcetext = Sourcetext & vbCrLf & Date:  & Format(Date, Ddd)
        Sourcetext = Sourcetext & ,  & Format(Date, dd Mmm YYYY) &  
        Sourcetext = Sourcetext & Format(Time, hh:mm:ss) &  +0100 & vbCrLf
        Sourcetext = Sourcetext & X-Mailer: Visual Basic Mailing Tester
        Sourcetext = Sourcetext & vbCrLf & To: < & ReceiverMail & >
        Sourcetext = Sourcetext & vbCrLf & Subject:  & Subject & vbCrLf
        Sourcetext = Sourcetext & vbCrLf & Mailtext & vbCrLf & vbCrLf & . & vbCrLf
        
       ->Verbindung aufbauen
        lblStatus.Caption = Verbindung zum Server wird aufgebaut & vbNewLine
        ini = WriteLog(StatusMail, CDbl(CDate(Now)), Verbindung zum Server wird aufgebaut)
        Winsock1.LocalPort = 0
        Winsock1.RemotePort = ServerPort
        Winsock1.Connect (ServerAdd)
        If Not Response(220) Then
          lblStatusErg.Caption = lblStatusErg.Caption & ERROR & vbNewLine
          GoTo ERRORMail
        End If
        lblStatusErg.Caption = lblStatusErg.Caption & OK & vbNewLine
        
       ->Verbunden
        Winsock1.SendData (HELO  & Domain & vbCrLf)
        ini = WriteLog(StatusMail, CDbl(CDate(Now)), Verbindung erfolgreich aufgebaut)
        
       ->Authorisierung
        lblStatus.Caption = lblStatus.Caption & Authorisierung & vbNewLine
        ini = WriteLog(StatusMail, CDbl(CDate(Now)), Authorisierung)
        Winsock1.SendData (AUTH LOGIN & vbCrLf)
        If Not Response(334) Then
          lblStatusErg.Caption = lblStatusErg.Caption & ERROR & vbNewLine
          GoTo ERRORMail
        End If
        lblStatusErg.Caption = lblStatusErg.Caption & vbNewLine
       
       ->Loginname wird base64 codiert übergeben
        lblStatus.Caption = lblStatus.Caption & Überprüfe Login & vbNewLine
        ini = WriteLog(StatusMail, CDbl(CDate(Now)), Überprüfe Login)
        Winsock1.SendData (Login64 & vbCrLf)
        If Not Response(334) Then
          lblStatusErg.Caption = lblStatusErg.Caption & ERROR & vbNewLine
          ini = WriteLog(StatusMail, CDbl(CDate(Now)), Login: Falsch - Überprüfen Sie die Einstellungen)
          GoTo ERRORMail
        End If
        lblStatusErg.Caption = lblStatusErg.Caption & OK & vbNewLine
        ini = WriteLog(StatusMail, CDbl(CDate(Now)), Login: OK)
        
       ->Passwort wird base64 codiert und übergeben
        lblStatus.Caption = lblStatus.Caption & Überprüfe Passwort & vbNewLine
        ini = WriteLog(StatusMail, CDbl(CDate(Now)), Überprüfe Passwort)
        Winsock1.SendData (Pass64 & vbCrLf)
        If Not Response(235) Then
          lblStatusErg.Caption = lblStatusErg.Caption & ERROR & vbNewLine
          ini = WriteLog(StatusMail, CDbl(CDate(Now)), Passwort: Falsch - Überprüfen Sie die Einstellungen)
          GoTo ERRORMail
        End If
        lblStatusErg.Caption = lblStatusErg.Caption & OK & vbNewLine
        ini = WriteLog(StatusMail, CDbl(CDate(Now)), Password: OK)
        
       ->Mail Senden
        lblStatus.Caption = lblStatus.Caption & Email wird gesendet & vbNewLine
        ini = WriteLog(StatusMail, CDbl(CDate(Now)), Email wird gesendet)
        Winsock1.SendData (MAIL FROM:< & SendEMail & > & vbCrLf)
        If Not Response(250) Then
          lblStatusErg.Caption = lblStatusErg.Caption & ERROR & vbNewLine
          ini = WriteLog(StatusMail, CDbl(CDate(Now)), Fehler! beim senden von: MAIL FROM:< & SendEMail & >)
          GoTo ERRORMail
        End If
        Winsock1.SendData (RCPT TO:< & ReceiverMail & > & vbCrLf)
        If Not Response(250) Then
          lblStatusErg.Caption = lblStatusErg.Caption & ERROR & vbNewLine
          ini = WriteLog(StatusMail, CDbl(CDate(Now)), Fehler! beim senden von: RCPT TO:< & ReceiverMail & >)
          GoTo ERRORMail
        End If
        Winsock1.SendData (DATA & vbCrLf)
        If Not Response(354) Then
          lblStatusErg.Caption = lblStatusErg.Caption & ERROR & vbNewLine
          ini = WriteLog(StatusMail, CDbl(CDate(Now)), Fehler! beim senden von: DATA)
          GoTo ERRORMail
        End If
        Winsock1.SendData (Sourcetext)
        If Not Response(250) Then
          lblStatusErg.Caption = lblStatusErg.Caption & ERROR & vbNewLine
          ini = WriteLog(StatusMail, CDbl(CDate(Now)), Fehler! beim senden vom Sourcetext)
          GoTo ERRORMail
        End If
        
        lblStatusErg.Caption = lblStatusErg.Caption & OK & vbNewLine
        
       ->Trennen
        lblStatus.Caption = lblStatus.Caption & Verbindung mit Server trennen & vbNewLine
        ini = WriteLog(StatusMail, CDbl(CDate(Now)), Verbindung mit Server trennen)
        Winsock1.SendData (quit & vbCrLf)
        lblStatusErg.Caption = lblStatusErg.Caption & OK & vbNewLine
        ini = WriteLog(StatusMail, CDbl(CDate(Now)), Verbindung getrennt)
        Sendmail = True
      End If
      
    ERRORMail:
      Winsock1.Close
      Mailing = False
    End Function
    
    Private Function Response(RCode$) As Boolean
      Sec = 0
      TimerSec.Interval = 200
      TimerSec.Enabled = True
      Response = True
      
      Do While InStr(1, Result, RCode) = 0
        DoEvents
        If Sec > TimeOut * 5 Then
          If Len(Result) Then
            lblMainStatus.ForeColor = &HC0&
            lblMainStatus.Caption = SMTP Error! Falscher Rückgabewert
            ini = WriteLog(StatusMail, CDbl(CDate(Now)), SMTP Error! Falscher Rückgabewert)
          Else
            lblMainStatus.ForeColor = &HC0&
            lblMainStatus.Caption = SMTP Error! Time out
            ini = WriteLog(StatusMail, CDbl(CDate(Now)), SMTP Error! Time out)
          End If
          
          Response = False
          Exit Do
        End If
      Loop
     
      Result = 
      TimerSec.Enabled = False
    End Function
    
    Private Function base64_encode(Code2() As Byte, Source As String) As String
      On Error GoTo base64_encode_Err
      
      Dim n As Long
      Dim i As Long
      Dim c1 As Integer
      Dim c2 As Integer
      Dim c3 As Integer
      Dim w(4) As Integer
      Dim sourceB() As Byte
      Dim Result() As Byte
      Dim l As Long
      Dim k As Long
      Dim rest As Long
      Dim cnt
      
      l = Len(Source)
      If l = 0 Then Exit Function
      sourceB() = StrConv(Source, vbFromUnicode)
      rest = l Mod 3
      If rest > 0 Then
        n = ((l \ 3) + 1) * 3
        ReDim Preserve sourceB(n - 1)
      Else
        n = l
      End If
      ReDim Result(4 * n / 3 - 1)
      cnt = 0
      For i = 0 To n / 3 - 1
        k = 3 * i
        c1 = sourceB(k)
        c2 = sourceB(k + 1)
        c3 = sourceB(k + 2)
        
        w(1) = Int(c1 / 4)
        w(2) = (c1 And 3) * 16 + Int(c2 / 16)
        w(3) = (c2 And 15) * 4 + Int(c3 / 64)
        w(4) = c3 And 63
        
        k = 4 * i
        Result(k) = B64(w(1))
        Result(k + 1) = B64(w(2))
        Result(k + 2) = B64(w(3))
        Result(k + 3) = B64(w(4))
      Next
      
      Select Case rest
        Case 1
          Result(UBound(Result)) = 61
          Result(UBound(Result) - 1) = 61
        Case 2
          Result(UBound(Result)) = 61
      End Select
      
      base64_encode = StrConv(Result, vbUnicode)
    
    base64_encode_End:
      Exit Function
      
    base64_encode_Err:
      lblMainStatus.ForeColor = &HC0&
      lblMainStatus.Caption = Fehler beim encoden
      ini = WriteLog(StatusMail, CDbl(CDate(Now)), Fehler beim encoden:  & Err &  /  & Error$ &  / )
      Resume base64_encode_End
    End Function
    
    Private Function CreateMsg()
      Set oStream = oFSO.CreateTextFile(.\SendMail.txt, True)
      With oStream
        .WriteLine ===================================================
        .WriteLine Tägliche Status-Mail ( & Format(Now, dd.mm.yyyy - hh:mm:ss) & )
        .WriteLine ===================================================
        .WriteBlankLines 1
        
        .Write Virenupdate 
        If GetINI(VirenUpdate, Status) = 1 Then
          .Write vom  & Format(GetINI(VirenUpdate, LastCheck), dd.mm.yyyy)
          .WriteBlankLines 1
          .WriteLine Replace(GetINI(VirenUpdate, MailStatus), |, vbNewLine)
        Else
          .Write deaktiviert!
        End If
        .WriteBlankLines 1
        .WriteLine ====================================================================================
        .WriteBlankLines 1
        
        .Write Datensicherung 
        If GetINI(Datensicherung, Status) = 1 Then
          .Write vom  & Format(GetINI(Datensicherung, LastCheck), dd.mm.yyyy)
          .WriteBlankLines 1
          .WriteLine Replace(GetINI(Datensicherung, MailStatus), |, vbNewLine)
        Else
          .Write deaktiviert!
        End If
        .WriteBlankLines 1
        .WriteLine ====================================================================================
        .WriteBlankLines 1
        
        .Write File-System 
        If GetINI(FileSystem, Status) = 1 Then
          .Write vom  & Format(Now, dd.mm.yyyy)
          .WriteBlankLines 1
          
          For Each theDrive In oFSO.Drives
             .WriteBlankLines 1
            .WriteLine --------------------------------------------------------------
            .WriteBlankLines 1
            .WriteLine  - Laufwerk  & theDrive
            .WriteBlankLines 1
            If theDrive.IsReady Then
              If GetINI(FileSystem, SendDriveType) = 1 Then .WriteLine     Laufwerkstyp:   & frmFileSystemMain.Laufwerkstyp(theDrive.DriveType)
              If GetINI(FileSystem, SendTotalSize) = 1 Then .WriteLine     Gesamtkapazität:   & FormatNumber(theDrive.TotalSize / 1024, 0) &  KB
              If GetINI(FileSystem, SendAvailableSpace) = 1 Then .WriteLine     Noch verfügbar:   & FormatNumber(theDrive.AvailableSpace / 1024, 0) &  KB
              If GetINI(FileSystem, SendFileSystem) = 1 Then .WriteLine     Dateisystem:   & theDrive.FileSystem
              If GetINI(FileSystem, SendVolumeName) = 1 Then .WriteLine     Bezeichnung:   & theDrive.VolumeName
              If GetINI(FileSystem, SendSerialNumber) = 1 Then .WriteLine     Seriennummer:   & theDrive.SerialNumber
              If GetINI(FileSystem, SendShareName) = 1 And theDrive.DriveType = 3 Then .WriteLine     Freigabename:   & theDrive.ShareName
            Else
              .WriteLine     Laufwerk ist nicht bereit!
            End If
          Next
        Else
          .Write deaktiviert!
        End If
        .WriteBlankLines 1
        .WriteLine ====================================================================================
      End With
    End Function

    Ich weiss, ich weiss.. ist ziehmlich lang, aber wer lust und Laune hat, darf ruhig nach Fehlern suchen ;)

    hF & gL :p


    mfG
    sp00n
     
  2. OuuhhhOuuuhhOuuhhh ;)
    wie peinlich.. hab den Fehler schon :)

    Die Timer dürfen nicht so aussehen:
    Code:
    Private Sub TimerClose_Timer()
      Unload Me
      TimerClose.Enabled = False
    End Sub
    
    Private Sub TimerSend_Timer()
      SendmailStart
      TimerSend.Enabled = False
    End Sub
    sondern so:

    Code:
    Private Sub TimerClose_Timer()
      TimerClose.Enabled = False
      Unload Me
    End Sub
    
    Private Sub TimerSend_Timer()
      TimerSend.Enabled = False
      SendmailStart
    End Sub
    *g :D

    mfG sp00n
     
Die Seite wird geladen...

Finde den Fehler nicht -.- - Ähnliche Themen

Forum Datum
Tastatureingabe R und N werden durch M ersetzt. Finde den Fehler nicht Windows 7 Forum 18. Jan. 2011
Fehlermeldung: Das System kann die angegebene Datei nicht finden Microsoft Office Suite 4. Mai 2010
Gerätetreiberproblem - Wie finde ich diesen fehler Treiber & BIOS / UEFI 22. Apr. 2010
Fehler auf dem ich keine Lösung finde... Windows XP Forum 4. Mai 2006
Kann Fehler in Formel nicht finden Windows XP Forum 15. Aug. 2005