Fragensteller
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
Alle Antworten
-
Hallo Andreas,
Du sollst nicht das Skript hier herein kopieren, sondern das Skript auf Deinem Rechner ausführen lassen und die Ausgabedatei in Deine Antwort kopieren.
Gruß von der Schlei
Uli
--
Web: http://www.hbcifm99.de/
RSS: http://www.hbcifm99.de/hbcifm99.atom.xml