' Berührungslose Kopfkontrolle: ' Erzeugt Remote Einträge auf dem lokalen Rechner und auf dem Remote-Rechner Option Explicit Dim wshshell,fso,i,Fnct Dim strPath,strSystemFolder,strWinFolder,strTempFolder '----------------------------- Objekte erzeugen -------------------------------- Set wshshell = CreateObjectSafely("WScript.Shell") Set fso = CreateObjectSafely("Scripting.FileSystemObject") Set Fnct = CreateObject("Install.Functions") '--------------------------- Standardpfade ------------------------------------- strPath = GetCurrentPath() strSystemFolder = fso.GetSpecialFolder(1) & "\" strWinFolder = fso.GetSpecialFolder(0) & "\" strTempFolder = fso.GetSpecialFolder(2) & "\" Dim strMainVolume,strComputerIni,strComputerXml strMainVolume = ExpandPath("%MAIN_VOLUME%","c:\") strComputerIni = strMainVolume & "Computer.ini" strComputerXml = strMainVolume & "Computer.xml" '------------------------------ Main ------------------------------------------- Call wshshell.Run("regedit.exe /s " & strPath & "LooseEnd\Remote.reg") Dim strRegFile strRegFile = strTempFolder & "\Register.reg" Call fso.CopyFile(strPath & "LooseEnd\Register.reg", strTempFolder, True) Call fso.CopyFile(strPath & "LooseEnd\LERegistry.bat", strTempFolder, True) Call fso.CopyFile(strPath & "LooseEnd\LERegistry.txt", strTempFolder, True) Dim strRegFileContent Dim RegFile Set RegFile = fso.OpenTextFile(strRegFile) strRegFileContent = RegFile.ReadAll() Call RegFile.Close() Dim strLastIpByte strLastIpByte = Fnct.GetIniString("CD1_Setup", "TcpIp", "c:\Computer.ini") If strLastIpByte = "" Then strLastIpByte = "3" strRegFileContent = Replace(strRegFileContent,"aa,bb,cc,dd,ee,ff", GetHexAmsNetId()) Set RegFile = fso.OpenTextFile(strRegFile,2) Call RegFile.Write(strRegFileContent) Call RegFile.Close() Dim l_strTargetIp l_strTargetIp = Fnct.GetIniString("TmpAddress","LooseEndDetector",strComputerIni) If l_strTargetIp = "" Then l_strTargetIp = "172.16.17.17" Dim strCmdFile,strCmdFileContent Dim CmdFile strCmdFile = strTempFolder & "\LERegistry.txt" Set CmdFile = fso.OpenTextFile(strCmdFile) strCmdFileContent = CmdFile.ReadAll() Call CmdFile.Close() strCmdFileContent = Replace(strCmdFileContent,"172.16.17.17",l_strTargetIp) Set CmdFile = fso.OpenTextFile(strCmdFile,2) Call CmdFile.Write(strCmdFileContent) Call CmdFile.Close() Call wshshell.Run("""" & strTempFolder & "LERegistry.bat""",1,True) Call fso.DeleteFile(strRegFile,True) Call fso.DeleteFile(strCmdFile,True) Call fso.DeleteFile(strTempFolder & "LERegistry.bat",True) '------------------------------- Funktionen ------------------------------------ Function GetCurrentPath() Dim l_strScriptName Dim l_strTemp l_strScriptName = WScript.ScriptFullName l_strTemp = WScript.ScriptName GetCurrentPath = Left(l_strScriptName, Len(l_strScriptName) - Len(l_strTemp)) End Function Function ExpandPath(p_strEnvironment,p_strDefault) Dim l_strTemp l_strTemp = wshshell.ExpandEnvironmentStrings(p_strEnvironment) If l_strTemp = p_strEnvironment Then l_strTemp = p_strDefault End If ExpandPath = l_strTemp End Function 'Hilfsfunktion zum Erzeugen von Objekten 'Ist die Erzeugung nicht möglich, wird das Skript beendet Function CreateObjectSafely(p_strObject) Dim i i = 0 On Error Resume Next Do err.Clear i = i+1 Set CreateObjectSafely = CreateObject(p_strObject) WScript.Sleep 1000 Loop Until Err.Number = 0 OR i > 30 If Err.Number <> 0 Then MsgBox "Unable to Create Object: " & p_strObject WScript.Quit End If On Error Goto 0 End Function Function GetHexAmsNetId Dim SysServer Dim strAmsNetId Dim strByte Dim i Set SysServer = CreateObject("TcSystemSrv.TcSystemServer") strAmsNetId = SysServer.AmsNetId Dim strNewAddress For i = 0 To 5 If i > 0 Then strNewAddress = strNewAddress + "," End If strByte = Hex(GetByte(strAmsNetId,i)) If Len(strByte) = 1 Then strByte = "0" + strByte strNewAddress = strNewAddress & strByte Next GetHexAmsNetId = strNewAddress End Function Function GetByte(strIpTypeString, nIdx) Dim StartPos Dim i StartPos = 1 'Positionieren If nIdx > 0 Then Dim nCnt nCnt = 0 For i = 1 To nIdx StartPos = Instr(StartPos,strIpTypeString,".") StartPos = StartPos + 1 Next End If Dim strResult,strCurrentChar strResult = "" Do strCurrentChar = Mid(strIpTypeString,StartPos,1) strResult = strResult + strCurrentChar StartPos = StartPos + 1 Loop Until StartPos > Len(strIpTypeString) Or Mid(strIpTypeString,StartPos,1) = "." GetByte = strResult End Function '------------------------------ Sub -------------------------------------------