none
Dauerauftrag ändern - Fehlermeldung

    Frage

  • Hallo Uli, hallo Newsgroup,

    schon viele Jahre bin ich Money99 Freund, war auch schon in der BetaTestGruppe. (Damals)

    Jetzt, mit WIN 7 möchte ich einen bestehenden Dauerauftrag bei der Bank mit Money99 Hbci mit Chipkarte ändern.

    HBCI Verbindung wird aufgebaut, dann Abbruch mit Fehlermeldung. Rest funktioniert.

    Habe auf 2 Banken versucht einen bestehenden DA zu ändern - beidesmal gleicher Fehler.

    Hier das Script- hat sich wohl auch veränder seit WIN 2000 ;-) ...

    ' VBScript source code
    version = "1.23"

    dot = instr(WScript.Version, ".")
    major = left(WScript.Version, dot-1)
    minor = mid(WScript.Version, dot+1)

    If major < 5 OR ( major = 5 AND minor < 6 ) Then
        WScript.Echo "Dieses Script benötigt mindestens Windows Script Host Version 5.6"
        WScript.Echo "zur korrekten Auswertung der Signatur an diesem Script. Die auf"
        WScript.Echo "diesem Rechner installierte Version ist " & WScript.Version & "."
        WScript.Echo "Die aktuelle Version ist bei Microsoft herunterladbar unter"
        WScript.Echo "http://www.microsoft.com/technet/scriptcenter/newswire/wsh57.mspx"
        WScript.Echo
        WScript.Echo "Alternativ kann auch die Versions- und Signaturüberprüfung"
        WScript.Echo "zu Beginn dieses Scripts einfach entfernt werden. Es sollte"
        WScript.Echo "dann ohne weitere Überprüfung ausgeführt werden."
        WScript.Quit(1)
    End if

    Dim WshShell, fso

    Set WshShell = WScript.CreateObject("WScript.Shell")
    Set fso = CreateObject("Scripting.FileSystemObject")

    i = InStr(1, WScript.FullName, "\system32\", 1)

    If i > 0 Then
      alt = Replace(WScript.FullName, "\SYSTEM32\", "\SysWOW64\", 1, 1, vbTextCompare)
     
      If fso.FileExists(alt) Then
        alt = alt & " " & """" & WScript.ScriptFullName & """"

        For i = 0 to WScript.Arguments.length - 1
          alt = alt & " " & WScript.Arguments(i)
        Next

        WshShell.Run(alt)
        WScript.Quit(0)
      End If
    End If

    Dim Signer
    Set Signer = CreateObject("Scripting.Signer")

    OK = Signer.VerifyFile(Wscript.ScriptFullName, true)

    If Not OK Then
      Err.Raise 507, "mnycheck.vbs", "Signatur konnte nicht überprüft werden"
    End If

    Dim MoneyFiles, MoneySystemFiles, MoneySetupFiles
    Dim result

    MoneyFiles = _
     Array ( "MSMONEY.EXE" )
    MoneySetupFiles = _
     Array( "ACMSETUP.HLP", "COMPLINC.DLL", "MNY6STP.DLL", _
            "MONEY99.INF", "MSSETUP.DLL", "ODBCKEY.INF", _
            "ODBCSTF.DLL", "OFFSETUP.TTF", "SETUP.EXE" )
    MoneySystemFiles = _
     Array ( "BANKTEXT.DAT", "BDS.DLL", "BLZ.DLL", _
             "COMPDLL.DLL", "DBCNV99.DLL", "HELPER.DLL", _
             "INXRTDLL.DLL", "LEXDLL2.DLL", "MNYADV.DLL", _
             "MNYCORE.DLL", "MNYINET.DLL", "MNYMAXSC.DLL", _
             "MNYMAXUI.DLL", "MNYMAXWZ.DLL", "MNYOB99.DLL", _
             "MNYOLINV.DLL", "MNYONL.DLL", "MNYTOMWZ.DLL", _
             "MNYUTIL.DLL", "MPACCT.DLL", "MPBANK.DLL", _
             "MPBDGT.DLL", "MPBILL.DLL", "MPBMAN.DLL", _
             "MPCONT.DLL", "MPCTCLS.DLL", _
             "MPGWDAT.DLL", "MPGWDEP.DLL", "MPGWDON.DLL", _
             "MPGWINC.DLL", "MPGWINS.DLL", "MPGWRET.DLL", _
             "MPGWROB.DLL", "MPGWSLF.DLL", "MPGWTAX.DLL", _
             "MPIAD.DLL", "MPINV.DLL", "MPINVTR.DLL", _
             "MPLOAN.DLL", "MPLST.DLL", _
             "MPOVER.DLL", "MPPAY.DLL", "MPPLAN.DLL", _
             "MPPORT.DLL", "MPRPT.DLL", "MPWEB.DLL", _
             "MPWSHM.DLL", "MPWSLN.DLL", "MSCOFD.DLL", _
             "MSFDPB99.DLL", "MSOFD.DLL", "MSPFCTL0.DLL", _
             "OFX.DLL", "OLSETUP.DLL", "OLSHARED.DLL", _
             "OLUTDLL.DLL", "PFCPLAN.DLL", "PFPLAN.DLL", _
             "PLANUI.DLL", "Q2MNY.DLL", "QREAD.DLL", _
             "RCHMN32.DLL", "SMRTCONN.DLL", "SMRTSYNC.DLL", _
             "TOMCLI.DLL", "TOMSRV.DLL", "VIPBLZ32.DLL", _
             "VIPDAT32.DLL", "XML.DLL", "XSOFC.DLL", _
             "XSSHIM.DLL", "Zka.dll", "ZKAPROT.DLL", _
             "ZKATRANS.DLL", "ZKAUI.DLL" )

    SetLocale("de")

    Function CompareDates(date1, date2)
      if ( Year(date1) < Year(date2) ) then
        CompareDates = -1
      ElseIf ( Year(date1) > Year(date2) ) then
        CompareDates = 1
      ElseIf ( Month(date1) < Month(date2) ) then
        CompareDates = -1
      ElseIf ( Month(date1) > Month(date2) ) then
        CompareDates = 1
      ElseIf ( Day(date1) < Day(date2) ) then
        CompareDates = -1
      ElseIf ( Day(date1) > Day(date2) ) then
        CompareDates = 1
      ElseIf ( Hour(date1) < Hour(date2) ) then
        CompareDates = -1
      ElseIf ( Hour(date1) > Hour(date2) ) then
        CompareDates = 1
      ElseIf ( Minute(date1) < Minute(date2) ) then
        CompareDates = -1
      ElseIf ( Minute(date1) > Minute(date2) ) then
        CompareDates = 1
      ElseIf ( Second(date1) < Second(date2) ) then
        CompareDates = -1
      ElseIf ( Second(date1) > Second(date2) ) then
        CompareDates = 1
      Else
        CompareDates = 0
      End If
    End Function
     
    Function GetVersion(fso, searchpath, filename)
      For Each path In searchpath
        path = trim(path)
        If right(path, 1) <> "\" Then
          path = path & "\"
        End If
        
        f = path & filename
        
        if fso.FileExists(f) then
          GetVersion = fso.GetFileVersion(f)
          Exit For
        else
          GetVersion = f & " nicht gefunden"
        end if
      Next
    end Function

    Function GetOSVersion()
      On Error Resume Next
     
      Dim os
     
      os = WshShell.RegRead("HKLM\SYSTEM\CurrentControlSet\Control\ProductOptions\ProductType")
     
      if err.number <> 0 then
        err.Clear
        
        os = WshShell.RegRead("HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\VersionNumber")
        
        if err.number <> 0 then
          err.Clear
          GetOSVersion = "unbekannte Windows Version"
        else
          is9X = true
          
          select case os
            case "4.00.950"
              GetOsVersion = "Windows 95A"
              
            case "4.00.1111"
              Dim subos
              
              subos = WshShell.RegRead("HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\SubVersionNumber")
              
              if err.number <> 0 then
                err.Clear
                subos = ""
              end if
              
              select case subos
                case " B"
                  GetOsVersion = "Windows 95B"
                  
                case " C"
                  GetOsVersion = "Windows 95C"
                  
                case else
                  GetOsVersion = "unbekanntes Windows 95 (" & subos & ")"
              end select
              
            case "4.03.1214"
              GetOsVersion = "Windows 95B (4.03.1214)"
              
            case "4.10.1998"
              GetOsVersion = "Windows 98"
              
            case "4.10.2222"
              GetOsVersion = "Windows 98SE"
              
            case "4.90.3000"
              GetOsVersion = "Windows ME"
              
            case else
              GetOsVersion = "unbekanntes W9X/ME (" & os & ")"
          end select
        end if
      else
        is9X = false
          
        os = WshShell.RegRead("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProductName")
          
        if err.number <> 0 then
          err.Clear
          os = "unbekanntes NT"
        else
          Dim sp
            
          sp = WshShell.RegRead("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\CSDVersion")
            
          if err.number <> 0 then
            err.Clear
            sp = WshShell.RegRead("HKLM\SYSTEM\CurrentControlSet\Control\Windows\CSDVersion")
            
            if err.number <> 0 then
              err.Clear
              os = os & " (unbekannter SP)"
            else
              if sp > 0 then
                os = os & " (SP" & sp/256 & ")"
              else
                os = os & " (ohne SP)"
              end if
            end if
          else
            os = os & " (" & sp & ")"
          end if
        end if

        Dim sc
        Set sc = GetObject("winmgmts:\\.\root\CIMV2")

        if err.number <> 0 then
          err.clear
        else
          Set cpus = sc.ExecQuery("Select * from Win32_Processor")

          Dim first
          first = true

          for each cpu in cpus
            if first then
              if cpu.AddressWidth = cpu.DataWidth then
                os = os & " " & cpu.AddressWidth & "bit"
              else
                os = os & " " & cpu.AddressWidth & "bit (data " & cpu.DataWidth & "bit)"
              end if
              first = false
            end if
          next
        end if


          if err.number <> 0 then
            os = os & err.Description
            err.clear
          end if

        GetOSVersion = os
      end if
    End Function

    Sub CheckFiles(fso, folder, files, ByRef filename, ByRef lastModified)
      On Error Resume Next
        
      For Each file in files
        Set f = fso.GetFile(folder & file)
        
        If Err.number <> 0 Then
          result = result & vbCrLf & "Fehler bei Datei " & folder & file & ": " & CStr(Err.number) & " " & Err.Description
          err.clear
        ElseIf CompareDates(f.DateLastModified, lastModified) < 0 Then
          filename = file
          lastmodified = f.DateLastModified
        End If
      Next
    End Sub

    Dim bKey, is9X, outputDir

    If WScript.Arguments.length > 1 Then
      outputFilename = WScript.Arguments(1)
    Else
      outputFilename = "mny_result_" & year(date) _
               & right(month(date)+100,2) _
               & right(day(date)+100,2) _
                 & right(hour(time)+100,2) & right(minute(time)+100,2) & ".txt"
    End If

    If WScript.Arguments.length > 0 Then
      outputDir = WScript.Arguments(0)
    Else
      outputDir = ""
    End If

    Set WshProcessEnv = WshShell.Environment("PROCESS")
    windir = WshProcessEnv("WINDIR")
    appdata = WshProcessEnv("APPDATA")

    rem Set WshSystemEnv = WshShell.Environment("SYSTEM")
    os = GetOSVersion()

    result = "Money 99V2000 & HBCIFM99 Systemprüfung " & version & " Stand " & Now
    result = result & vbCrLf & "OS Version: " & os

    result = result & vbCrLf & "Windir: " & windir
    result = result & vbCrLf & "Appdata: " & appdata

    on error resume next

    result = result & vbCrLf & "Explorer Version: " & GetVersion(fso, array(windir), "explorer.exe")

    iepath = WshShell.RegRead("HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\IEXPLORE.EXE\")

    if err <> 0 then
      err.Clear
      ieVersion = "AppPath nicht gefunden"
    else
      if fso.FileExists(iepath) then
        ieVersion = fso.GetFileVersion(iepath)
      else
        ieVersion = "nicht gefunden"
      end if
    end if

    result = result & vbCrLf & "Internet Explorer version: " & ieVersion

    result = result & vbCrLf & "Locale: " & GetLocale

    if not is9X then
      Dim lang
      lang = ""
      langkey = "HKCU\Control Panel\International\"

      Dim langkeys(10)
      langkeys(0) = array ( "sCountry", "Land", "Deutschland" )
      langkeys(1) = array ( "sDate", "Datumstrennzeichen", "." )
      langkeys(2) = array ( "sDecimal", "Dezimaltrennzeichen", "," )
      langkeys(3) = array ( "sGrouping", "Zifferngruppierung", "3;0" )
      langkeys(4) = array ( "sLanguage", "Sprache", "DEU" )
      langkeys(5) = array ( "sNegativeSign", "Minuszeichen", "-" )
      langkeys(6) = array ( "sPositiveSign", "Pluszeichen", "" )
      langkeys(7) = array ( "sThousand", "Symbol für Zifferngruppierung", "." )
      langkeys(8) = array ( "sMonDecimalSep", "Währungsdezimaltrennzeichen", "," )
      langkeys(9) = array ( "sMonGrouping", "Währungszifferngruppierung", "3;0" )
      langkeys(10) = array ( "sMonThousandSep", "Symbol für Währungszifferngruppierung", "." )

      for each key in langkeys
        value = WshShell.RegRead( langkey & key(0) )
        
        if err <> 0 then
          WScript.Echo "Kann " & langkey & key(0) & " nicht lesen!" & vbCrLf & "Fehler: " & err.Description
          lang = lang & vbCrLf & "Fehler " & key(0) & ": " & err.Description
          err.Clear
        elseif value <> key(2) then
          lang = lang & vbCrLf & key(1) & " ist '" & value & "' statt '" & key(2) & "'"
        end if
      next

      if lang = "" then
        result = result & vbCrLf & "Regionsoptionen korrekt für Deutschland eingestellt"
      else
        result = result & lang
      end if
    else
     result = result & vbCrLf & "Regionsoptionen wegen Windows 9X nicht überprüft"  
    end if

    commonfilesdir = WshShell.RegRead("HKLM\Software\Microsoft\Windows\CurrentVersion\CommonFilesDir")

    if err <> 0 then
      WScript.Echo "Kann CommonFilesDir nicht feststellen!" & vbCrLf & "Fehler: " & err.Description
      err.Clear
    else
      result = result & vbCrLf & "CommonFilesDir: " & commonfilesdir
    end if

    commonfilesdirx86 = WshShell.RegRead("HKLM\Software\Microsoft\Windows\CurrentVersion\CommonFilesDir (x86)")

    if err <> 0 then
      err.Clear
    else
      result = result & vbCrLf & "CommonFilesDir (x86): " & commonfilesdirx86
    end if


    Dim mny70regnames(3)
    mny70regnames(0) = "HKLM\Software\WOW6432Node\Microsoft\Money\7.0\"
    mny70regnames(1) = "HKLM\Software\Microsoft\Money\7.0\"
    mny70regnames(2) = "HKLM\Software\WOW6432Node\Microsoft\Money\8.0\"
    mny70regnames(3) = "HKLM\Software\Microsoft\Money\8.0\"

    Dim mny70reg

    For Each mnyreg In mny70regnames
      err.Clear
     
      mny70reg = mnyreg
      mnykey = WshShell.RegRead(mny70reg & "MoneyPath")

      if err = 0 then
        exit for
      end if
    Next

    if err <> 0 then
      WScript.Echo "Kann Pfad von Money nicht feststellen!" & vbCrLf & "Fehler: " & err.Description
      WScript.Quit(err.number)
    end if

    result = result & vbCrLf & "Money Version: " & GetVersion(fso, Array(mnykey), "msmoney.exe")

    mnylcid = WshShell.RegRead(mny70reg & "LCID")

    if err <> 0 then
      WScript.Echo "Kann Money LCID nicht feststellen!" & vbCrLf & "Fehler: " & err.Description
      err.Clear
    else
      result = result & vbCrLf & "Money LCID: " & mnylcid
    end if
     
    mnysku = WshShell.RegRead(mny70reg & "SKU")

    if err <> 0 then
      WScript.Echo "Kann Money SKU nicht feststellen!" & vbCrLf & "Fehler: " & err.Description
      err.Clear
    else
      result = result & vbCrLf & "Money SKU: " & mnysku
    end if
     
    result = result & vbCrLf & "mfc42.dll Version im Money-Verz.: "& GetVersion(fso, array(mnykey),"mfc42.dll")

    if Right(result, 14) = "nicht gefunden" then
      result = result & " (OK)"
    else
      result = result & " (FALSCH)"
    end if

    result = result & vbCrLf & "mfc42.dll Version im Windows-Verz.: " & GetVersion(fso, array(windir & "\SysWOW64\", windir & "\system32\", windir & "\system\", windir), "mfc42.dll")
    vipzka = GetVersion(fso, array(mnykey & "\system\"), "vipzka.exe")
    result = result & vbCrLf & "vipzka.exe Version: " & vipzka

    if vipzka = "3.0.0.17" then
      result = result & " (Orig. Money 99V2000 Decoder)"
    elseif vipzka = "3.0.0.54" then
      result = result & " (Money 99V2000 SP1 Decoder)"
    elseif left(vipzka, 5) <> "3.0.0" and left(vipzka, 3) = "3.0" then
      result = result & " (Stöckl Decoder)"
    end if

    hbcifm99 = GetVersion(fso, Array(mnykey & "\system\hbci\"), "hbcifm99.exe")
    result = result & vbCrLf & "HBCIFM99 Version: " & hbcifm99

    if hbcifm99 = "3.4.1.19" then
      result = result & " (FALSCH, lade Pre-Release http://www.hbcifm99.de/pr/ )"
    end if

    result = result & vbCrLf & "DDBAC Version: " & GetVersion(fso, Array(commonfilesdir & "\DataDesign\DDBAC\", commonfilesdirx86 & "\DataDesign\DDBAC\"), "DDBAC.DLL")

    ddbacdir = WshShell.RegRead("HKCU\Software\DataDesign\DDBAC\DataDir")

    if err <> 0 then
      err.Clear
      result = result & vbCrLf & "DDBAC Dir: DataDir nicht gesetzt"
    else
      result = result & vbCrLf & "DDBAC Dir: " & ddbacdir
    end if


    mdacVersion = WshShell.RegRead("HKEY_LOCAL_MACHINE\Software\Microsoft\DataAccess\FullInstallVer")
    mdacOle = ""

    if err.number <> 0 then
      err.Clear
      mdacVersion = GetVersion(fso, Array(commonfilesdir & "\System\Ole DB\"), "OLEDB32.dll")
      mdacOle = "(OLEDB32 Version)"
    end if

    Select Case mdacVersion
      Case "6.1.7600.16385"  mdac = "6.1 (Windows 7)"
      Case "6.0.6000.16386"  mdac = "6.0 (Vista)"
      Case "2.81.1132.0"  mdac = "2.8 SP2? (Windows XP SP3)"
      Case "2.81.1117.6"  mdac = "2.8 SP1 (Non Windows XP SP2)"
      Case "2.81.1117.0"  mdac = "2.8 SP1 (Windows XP SP2)"
      Case "2.80.1022.0"  mdac = "2.8"
      Case "2.80.1022.3"  mdac = "2.8"
      Case "2.71.9040.2"  mdac = "2.7 SP1"
      Case "2.70.9001.0"  mdac = "2.7"
      Case "2.62.7400.1"  mdac = "2.6 SP2"
      Case "2.61.7326.6"  mdac = "2.6 SP1"
      Case "2.60.6526.3"  mdac = "2.6"
      Case Else mdac = "unbekannte MDAC"
    End Select

    result = result & vbCrLf & "MDAC Version " & mdacOle & ": " & mdacVersion & " (" & mdac & ")"

    result = result & vbCrLf & "Jet 3.5 Version: " & GetVersion(fso, Array(windir & "\SysWOW64\", windir & "\system32\", windir & "\system\"), "msjet35.dll")

    jet40version = GetVersion(fso, Array(windir & "\SysWOW64\", windir & "\system32\", windir & "\system\"), "msjet40.dll")

    Select Case jet40version
      Case "4.0.2927.4"   jet40sp = "(SP3*)"
      Case "4.0.2927.17"  jet40sp = "(SP3 Office 2000 SR1*)"
      Case "4.0.3714.7"   jet40sp = "(SP4*)"
      Case "4.0.4431.1"   jet40sp = "(SP5*)"
      Case "4.0.4431.3"   jet40sp = "(SP5*)"
      Case "4.0.6218.0"   jet40sp = "(SP6*)"
      Case "4.0.6807.0"   jet40sp = "(SP6 Windows Server 2003*)"
      Case "4.0.7328.0"   jet40sp = "(SP7*)"
      Case "4.0.8015.0"   jet40sp = "(SP8*)"
      Case "4.0.8618.0"   jet40sp = "(Security Bulletin MS04-014*)"
      Case "4.0.9025.0"   jet40sp = "(Windows Server 2003 SP1 and Update Rollup 1 for Windows 2000 SP4)"
      Case "4.0.9511.0"   jet40sp = "(Security Bulletin MS08-028)"
      Case "4.0.9635.0"   jet40sp = "(Windows Vista)"
      Case "4.0.9756.0"   jet40sp = "(Windows 7)"
      Case Else jet40sp = "(unbekannter SP)"
    End Select

    result = result & vbCrLf & "Jet 4.0 Version: " & jet40version & " " & jet40sp
    result = result & vbCrLf & "ODBC Jet Version: " & GetVersion(fso, Array(windir & "\SysWOW64\", windir & "\system32\", windir & "\system\"), "odbcjt32.dll")

    Dim Filename, lastmodified

    lastmodified = Date

    CheckFiles fso, mnykey & "\", MoneyFiles, filename, lastmodified
    CheckFiles fso, mnykey & "\SETUP\", MoneySetupFiles, filename, lastmodified
    CheckFiles fso, mnykey & "\SYSTEM\", MoneySystemFiles, filename, lastmodified

    result = result &  vbCrLf & "Älteste Datei im Money-Ordner: " & filename & " " & lastmodified

    if CompareDates(lastmodified, #03/14/1999 23:00:00#) < 0 then
      result = result & " (FALSCH)"
    else
      result = result & " (OK)"
    end if

    setupkey = "HKLM\Software\Microsoft\MS Setup (ACME)\Table Files\"
    setupkeyx86 = "HKLM\SOFTWARE\Wow6432Node\Microsoft\MS Setup (ACME)\Table Files\"

    Dim setupnames(5)

    setupnames(0) = array ( "korrektes MS Money 99V2000 Plus (OK)", "Microsoft Money 99@v7.01.01.2222 (1031) Plus")
    setupnames(1) = array ( "MS Money 2000 (A/CH) (OK)", "Microsoft Money@v8.0.10.1020 (1031) 2000")
    setupnames(2) = array ( "korrektes MS Money 99V2000 Standard (OK)", "Microsoft Money@v7.01.01.2222 (1031) 99")
    setupnames(3) = array ( "Test Bugs-Money Version (FALSCH)", "Microsoft Money 99@v7.00.01.0629 (1031) Testversion")
    setupnames(4) = array ( "Bugs-Money 99 Plus (FALSCH)", "Microsoft Money 99@v7.00.01.0629 (1031) Plus")

    keyfound = 0

    For Each namearr In setupnames
      bKey = WshShell.RegRead(setupkey & namearr(1))
      if err = -2147024894 then
        rem Registrierungsschlüssel "..." wurde nicht zum Lesen geöffnet.
        err.Clear
        bKey = WshShell.RegRead(setupkeyx86 & namearr(1))
      end if

      if err = -2147024894 then
        rem Registrierungsschlüssel "..." wurde nicht zum Lesen geöffnet.
        err.Clear
      elseif err = 0 then
        result = result & vbCrLf & "MS Setup Registry Key zeigt " & namearr(0)
        keyfound = 1
      else
        result = result & vbCrLf & "Fehler " & CStr(err.number) & ": '" & err.Description & "' bei Suche nach " & namearr(1)
        err.clear
      end if
    Next
                    
    If keyfound = 0 Then
      result = result & vbCrLf & "MS Setup Registry Key für keine bekannte MS Money Version gefunden"
    End If

    quoteserver = WshShell.RegRead("HKLM\SOFTWARE\Microsoft\Investor\StockQuotes\QuoteServerURL\URL")

    if err <> 0 then
      err.Clear
      quoteserver = WshShell.RegRead("HKLM\SOFTWARE\Wow6432Node\Microsoft\Investor\StockQuotes\QuoteServerURL\URL")
    end if

    if err <> 0 then
      err.Clear
      result = result & vbCrLf & "Kann QuoteServerURL nicht in Registry finden! (FEHLER)"
    else
      result = result & vbCrLf & "QuoteServerURL: " & quoteserver
     
      if quoteserver = "http://data.moneycentral.msn.com/Scripts/invisapi.dll/" then
        result = result & " (OK)"
      ElseIf quoteserver = "http://investor.msn.com/Scripts/invisapi.dll/" Then
        result = result & " (OK)"
      Else
        result = result & " (FALSCH)"
      end if
    end if

    regclear = 1

    for each regkey IN Array( "InvFundCountries", "InvStockCountries", "WebQtSrvrName", "WebQtSrvrURL" )
      check = WshShell.RegRead(mny70reg & regkey)
     
      if err <> 0 then
        err.Clear
      else
        result = result & vbCrLf & "Registry Wert für " & regkey & " ist vorhanden! (FALSCH)"
        regclear = 0
      end if
    next

    if regclear = 1 then
      result = result & vbCrLf & "Alte Registry Werte sind entfernt. (OK)"
    end if

    SmrtInetURL = WshShell.RegRead(mny70reg & "Online\SmrtInetURL")

    if err <> 0 then
      err.Clear
     
      result = result & vbCrLf & "Registry Wert für SmrtInetURL ist nicht vorhanden! (FALSCH)"
    else
      result = result & vbCrLf & "SmrtInetURL: " & SmrtInetURL
     
      if SmrtInetURL = "http://money.gvogt.de/smrtinet.ini" then
        result = result & " (OK)"
      else
        result = result & " (unbekannt)"
      end if
    end if

    proxy = WshShell.RegRead("HKCU\Software\Microsoft\Windows\CurrentVersion\Internet Settings\ProxyEnable")

    if err <> 0 then
      err.Clear
      proxy = WshShell.RegRead("HKLM\Software\Microsoft\Windows\CurrentVersion\Internet Settings\ProxyEnable")
     
      if err <> 0 then
        proxy = 0
      elseif proxy then
        proxyserver = WshShell.RegRead("HKLM\Software\Microsoft\Windows\CurrentVersion\Internet Settings\ProxyServer")
        
        if err <> 0 then
          err.Clear
          proxyserver = ""
        end if
      end if
    elseif proxy then
      proxyserver = WshShell.RegRead("HKCU\Software\Microsoft\Windows\CurrentVersion\Internet Settings\ProxyServer")
     
      if err <> 0 then
        err.Clear
        proxyserver = ""
      end if
    end if

    if proxy then
      result = result & vbCrLf & "LAN-Proxy konfiguriert auf " & proxyserver
    else
      result = result & vbCrLf & "Kein LAN-Proxy konfiguriert"
    end if

    Set fwmgr = CreateObject("HNetCfg.FwMgr")

    if err <> 0 then
      err.Clear
      result = result & vbCrLf & "Windows Firewall kann nicht bestimmt werden"
    else
      Set fwprofile = fwmgr.LocalPolicy.CurrentProfile
      fwstate = "ausgeschaltet"
     
      if fwprofile.FirewallEnabled then
        fwstate = "eingeschaltet"
      end if
     
      result = result & vbCrLf & "Windows Firewall ist " & fwstate
    end if

    Set sc = GetObject("winmgmts:\\.\root\SecurityCenter")

    avcount = 0
    fwcount = 0
    aswcount = 0

    if err.number <> 0 then
      err.Clear
      result = result & vbCrLf & "Auf das XP Security Center kann nicht zugegriffen werden."
    else
      Set avprods = sc.ExecQuery("Select * from AntiVirusProduct")
     
      for each av in avprods
        avcount = avcount + 1
        result = result & vbCrLf & "Antivirus " & av.displayName & " " & av.versionNumber & " "
        
        if av.onAccessScanningEnabled then
          result = result & "aktiv"
        else
          result = result & "nicht aktiv"
        end if
      next

      Set fwprods = sc.ExecQuery("Select * from FirewallProduct")
     
      for each fw in fwprods
        fwcount = fwcount + 1
        result = result & vbCrLf & "Firewall " & fw.displayName & " " & fw.versionNumber & " "

        if fw.enabled then
          result = result & "aktiv"
        else
          result = result & "nicht aktiv"
        end if
      next
    end if

    Set sc2 = GetObject("winmgmts:\\.\root\SecurityCenter2")

    if err.number <> 0 then
      err.Clear
      result = result & vbCrLf & "Auf das Security Center 2 kann nicht zugegriffen werden."
    else
      Set avprods = sc2.ExecQuery("Select * from AntiVirusProduct")
     
      for each av in avprods
        avcount = avcount + 1
        result = result & vbCrLf & "Antivirus " & av.displayName & " ProductState " & av.productState & " "
        if (av.productState And 4096) = 0 then
          result = result & "nicht "
        end if
        result = result & "aktiv, "

        if (av.productState And 16) then
          result = result & "updaten"
        else
          result = result & "aktuell"
        end if
      next

      Set fwprods = sc2.ExecQuery("Select * from FirewallProduct")
     
      for each fw in fwprods
        fwcount = fwcount + 1
        result = result & vbCrLf & "Firewall " & fw.displayName & " ProductState " & fw.productState & " "
        if (fw.productState And 4096) = 0 then
          result = result & "nicht "
        end if
        result = result & "aktiv, "

        if (fw.productState And 16) then
          result = result & "updaten"
        else
          result = result & "aktuell"
        end if
      next

      Set aswprods = sc2.ExecQuery("Select * from AntiSpywareProduct")
     
      for each asw in aswprods
        aswcount = aswcount + 1
        result = result & vbCrLf & "AntiSpyware " & asw.displayName & " ProductState " & asw.productState & " "
        if (asw.productState And 4096) = 0 then
          result = result & "nicht "
        end if
        result = result & "aktiv, "

        if (asw.productState And 16) then
          result = result & "updaten"
        else
          result = result & "aktuell"
        end if
      next
    end if

    if avcount = 0 then
      result = result & vbCrLf & "Kein Antivirus erkannt."
    end if

    if fwcount = 0 then
      result = result & vbCrLf & "Keine Firewall erkannt."
    end if

    if aswcount = 0 then
      result = result & vbCrLf & "Keine AntiSpyware erkannt."
    end if

    Dim objBanking

    Set objBanking = CreateObject("DataDesign.BACBanking")

    if err.number <> 0 then
      err.Clear
    else
      Dim i
     
      For i = 0 To objBanking.Customers.Count-1
        Dim objCustomer, contact, progid, prefix
        Set objCustomer = objBanking.Customers(i)
        
        contact = "Kontakt " & i & ": " & objCustomer.Fields("Contact")
        contact = contact & " (" & objCustomer.Fields("BankName") & ")"
        contact = contact & " BLZ " & objCustomer.BankCode
        contact = contact & " HBCI " & objCustomer.Fields("HBCIVersion")
        contact = contact & " CommAddr " & objCustomer.Fields("CommunicationsAddress")
        
        projid = objCustomer.Fields("SecurityProgID")
        prefix = "DataDesign.BACSecurity"
        
        If Left(projid, Len(prefix)) = prefix Then
          contact = contact & " SecProgID " & Right(projid, Len(projid) - Len(prefix))
        Else
          contact = contact & " SecProgID " & projid
        End If
        
        Select Case objCustomer.Fields("SecurityMediaType")
          Case "0"  contact = contact & " MediaFile"
          Case "1"  contact = contact & " SmartCard"
          Case "3"  contact = contact & " BTX"
          Case "4"  contact = contact & " PINTAN"
          Case Else contact = contact & " SecMediaType " & objCustomer.Fields("SecurityMediaType")
        End Select

        if objCustomer.Fields("ITanSupported") = "1" Then
          contact = contact & " ITanSupported"
        end if

        if objCustomer.Fields("ITANVerfahren") <> "" Then
          contact = contact & " ITANVerf. " & objCustomer.Fields("ITANVerfahren")
        end if
        
        If objCustomer.Fields("Sicherheitsfunktion") <> "" Then
          contact = contact & " S-Fkt " & objCustomer.Fields("Sicherheitsfunktion")
        End If

        if objCustomer.Fields("ManualUPD") = "1" Then
          contact = contact & " ManualUPD"
        end if

        if objCustomer.Fields("ManualITan") = "1" Then
          contact = contact & " ManualITan"
        end if

        if objCustomer.Fields("NeedSynchronisation") = "1" Then
          contact = contact & " NeedSynchronisation"
        end if

        result = result & vbCrLf & contact
      Next
    end if

    if Len(outputDir) > 0 Then
      if not fso.FolderExists(outputDir) Then
        result = result & vbCrLf & "Ausgabeverzeichnis '" & outputDir & "' existiert nicht! Schreibe in aktuelles Verzeichnis!"
        outputDir = WshShell.CurrentDirectory
      End If
     
      outputFilename = fso.BuildPath(outputDir, outputFilename)
    End If

    Set outputFile = fso.CreateTextFile(outputFilename, true)
    outputFile.write result
    outputFile.close

    result = result & vbCrLf & "Ergebnisse gespeichert in " & outputFilename

    WScript.Echo result

    '' SIG '' Begin signature block
    '' SIG '' MIIIogYJKoZIhvcNAQcCoIIIkzCCCI8CAQExCzAJBgUr
    '' SIG '' DgMCGgUAMGcGCisGAQQBgjcCAQSgWTBXMDIGCisGAQQB
    '' SIG '' gjcCAR4wJAIBAQQQTvApFpkntU2P5azhDxfrqwIBAAIB
    '' SIG '' AAIBAAIBAAIBADAhMAkGBSsOAwIaBQAEFE+lE35g4lKU
    '' SIG '' A5nRx6JStiBmIDjxoIIGejCCAv0wggJmoAMCAQICAR0w
    '' SIG '' DQYJKoZIhvcNAQEFBQAwdzELMAkGA1UEBhMCSlAxETAP
    '' SIG '' BgNVBAgTCFRva3lvLXRvMRQwEgYDVQQKEwtHZXJhbGQg
    '' SIG '' Vm9ndDEeMBwGA1UEAxMVR2VyYWxkIFZvZ3QncyBSb290
    '' SIG '' IENBMR8wHQYJKoZIhvcNAQkBFhB2b2d0QHNwYW1jb3Au
    '' SIG '' bmV0MB4XDTA5MTIxNTE0MjMxMVoXDTExMTIxNjE0MjMx
    '' SIG '' MVowfjELMAkGA1UEBhMCREUxEDAOBgNVBAgTB0hhbWJ1
    '' SIG '' cmcxEDAOBgNVBAcTB0hhbWJ1cmcxFDASBgNVBAoTC0dl
    '' SIG '' cmFsZCBWb2d0MRQwEgYDVQQDEwtHZXJhbGQgVm9ndDEf
    '' SIG '' MB0GCSqGSIb3DQEJARYQdm9ndEBzcGFtY29wLm5ldDCB
    '' SIG '' nzANBgkqhkiG9w0BAQEFAAOBjQAwgYkCgYEA2AeZjnzR
    '' SIG '' fPd0SB0fohDgda30aFUMMxjLHD0yLxLhDsvunBdcnfNs
    '' SIG '' KNKgV+cLTJnFB+KY7RKsaKxMKA6QItydWUrd/PX9VkIk
    '' SIG '' 2Sr9ovnG0a/NHoUfJ3JPJLoQNba52U3JRkmwKFrgPZ6p
    '' SIG '' pKITv3kZswEX9OJ1azX0FBb3gsfV61kCAwEAAaOBkTCB
    '' SIG '' jjAJBgNVHRMEAjAAMBMGA1UdJQQMMAoGCCsGAQUFBwMD
    '' SIG '' MB0GA1UdDgQWBBTotCt9OMUuZZAry72igxSTWNyK1jAf
    '' SIG '' BgNVHSMEGDAWgBSvsEIP90lxOoGc1TTWOgZRRRgYqjAs
    '' SIG '' BgNVHR8EJTAjMCGgH6AdhhtodHRwOi8vd3d3Lmd2b2d0
    '' SIG '' Lm5ldC9jYS5jcmwwDQYJKoZIhvcNAQEFBQADgYEAnuVQ
    '' SIG '' gcZHGPTSLmdbUEHbZuWDRCYpYXJvlYZHZEJe5GpJmGbv
    '' SIG '' 8d/bxcrdJxMyMX+ee66cnhJbg7GGr16gn70eGaqI7OIC
    '' SIG '' 0J9aZBmJOLYdw8fBICLHh5DkznhwuguyeSCzz9mzIzGE
    '' SIG '' KqRWX2VhAHrEr/rJZKdNcn8huJ2j96ZHpcEwggN1MIIC
    '' SIG '' 3qADAgECAgEEMA0GCSqGSIb3DQEBBQUAMHcxCzAJBgNV
    '' SIG '' BAYTAkpQMREwDwYDVQQIEwhUb2t5by10bzEUMBIGA1UE
    '' SIG '' ChMLR2VyYWxkIFZvZ3QxHjAcBgNVBAMTFUdlcmFsZCBW
    '' SIG '' b2d0J3MgUm9vdCBDQTEfMB0GCSqGSIb3DQEJARYQdm9n
    '' SIG '' dEBzcGFtY29wLm5ldDAeFw0wNzA2MDMwNzI2NDVaFw0x
    '' SIG '' MTA2MDMwNzI2NDVaMHcxCzAJBgNVBAYTAkpQMREwDwYD
    '' SIG '' VQQIEwhUb2t5by10bzEUMBIGA1UEChMLR2VyYWxkIFZv
    '' SIG '' Z3QxHjAcBgNVBAMTFUdlcmFsZCBWb2d0J3MgUm9vdCBD
    '' SIG '' QTEfMB0GCSqGSIb3DQEJARYQdm9ndEBzcGFtY29wLm5l
    '' SIG '' dDCBnzANBgkqhkiG9w0BAQEFAAOBjQAwgYkCgYEAoKyN
    '' SIG '' umiyCtcaeBk+3PeLPY/Sx96QvfSBEfCTCeTVkVsa5Gg+
    '' SIG '' Cme1oUIIyKotzU6rfUIDGi83TkWxyXwjC3JTBdfY8ob+
    '' SIG '' pDuxbzEvj0ffHMAXRkdJiMBFIcg0Z27bCRA6g52+sKQm
    '' SIG '' dPiMcYSTkhYNh6K5hbhVs5BvK0rN4Oo/pSECAwEAAaOC
    '' SIG '' AQ8wggELMB0GA1UdDgQWBBSvsEIP90lxOoGc1TTWOgZR
    '' SIG '' RRgYqjCBoQYDVR0jBIGZMIGWgBSvsEIP90lxOoGc1TTW
    '' SIG '' OgZRRRgYqqF7pHkwdzELMAkGA1UEBhMCSlAxETAPBgNV
    '' SIG '' BAgTCFRva3lvLXRvMRQwEgYDVQQKEwtHZXJhbGQgVm9n
    '' SIG '' dDEeMBwGA1UEAxMVR2VyYWxkIFZvZ3QncyBSb290IENB
    '' SIG '' MR8wHQYJKoZIhvcNAQkBFhB2b2d0QHNwYW1jb3AubmV0
    '' SIG '' ggEEMAwGA1UdEwQFMAMBAf8wCwYDVR0PBAQDAgEGMCsG
    '' SIG '' A1UdHwQkMCIwIKAeoByGGmh0dHA6Ly93d3cuZ3ZvZ3Qu
    '' SIG '' ZGUvY2EuY3JsMA0GCSqGSIb3DQEBBQUAA4GBAIPnryEY
    '' SIG '' FZZPeylzrSaUqTa9FSJ7UvX/WKKGA+0P+Z8Vkt07b819
    '' SIG '' mvK194I/Ab4mewJLc80jPFyNqUs0mKWV4MkYmAmh8Jev
    '' SIG '' feTrsoMTF9eseEeMhK/aS3xPO7tT18FgEz8G/Hf5EzHF
    '' SIG '' RFMHA8i0HUDGq9CBGEuzg1xBsirv8nClMYIBlDCCAZAC
    '' SIG '' AQEwfDB3MQswCQYDVQQGEwJKUDERMA8GA1UECBMIVG9r
    '' SIG '' eW8tdG8xFDASBgNVBAoTC0dlcmFsZCBWb2d0MR4wHAYD
    '' SIG '' VQQDExVHZXJhbGQgVm9ndCdzIFJvb3QgQ0ExHzAdBgkq
    '' SIG '' hkiG9w0BCQEWEHZvZ3RAc3BhbWNvcC5uZXQCAR0wCQYF
    '' SIG '' Kw4DAhoFAKBwMBAGCisGAQQBgjcCAQwxAjAAMBkGCSqG
    '' SIG '' SIb3DQEJAzEMBgorBgEEAYI3AgEEMBwGCisGAQQBgjcC
    '' SIG '' AQsxDjAMBgorBgEEAYI3AgEVMCMGCSqGSIb3DQEJBDEW
    '' SIG '' BBQt7AbycX7rx+KLf/kQsCqxEAvmlzANBgkqhkiG9w0B
    '' SIG '' AQEFAASBgGPU8N2Hmv7hf99H5JH0OvabbkmJSviu+Eua
    '' SIG '' oiXYmpOoLj8uFkghC4727+0zuvt0GaR92zuL8aM6MgRC
    '' SIG '' 7atrCPBNKpNLoCWr84NcB9UdYN9KtIBD88Era2sPFZvV
    '' SIG '' jBEcIkj88/ZnGlA72/Hg25o6kkFc73i2ht9y+VHdPo5t
    '' SIG '' z89p
    '' SIG '' End signature block

    Danke für Die Rückantwort

    und Grüße von der Donau

    Andreas

    Sonntag, 18. Mai 2014 16:36

Alle Antworten