Dauerauftrag ändern - Fehlermeldung

• Frage

• 

  

  0

  Anmelden

  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

  Antworten

  |

  Zitieren