Option Explicit Dim wshshell,fso,i,Fnct Dim strPath,strSystemFolder,strWinFolder,strTempFolder '----------------------------- Objekte erzeugen -------------------------------- i = 0 On Error Resume Next Do err.Clear i = i+1 Set wshshell = CreateObject("WScript.Shell") Set fso = CreateObject("Scripting.FileSystemObject") Set Fnct = CreateObject("Install.Functions") WScript.Sleep 1000 Loop Until Err.Number = 0 OR i > 30 If Err.Number <> 0 Then WScript.Quit End If On Error Goto 0 '--------------------------- Standardpfade ------------------------------------- strPath = GetCurrentPath() strSystemFolder = fso.GetSpecialFolder(1) & "\" strWinFolder = fso.GetSpecialFolder(0) & "\" strTempFolder = fso.GetSpecialFolder(2) & "\" '------------------------------ Main ------------------------------------------- Dim strCurrentFolder,AllFiles,File,strTargetFolder,strTargetFile Dim SourceFolders(10) Dim strDateOrg,strDateNew,TmpFile,bCopied Dim CurrentFolder Dim FileAcc If wshshell.AppActivate ("Installation") THEN wshshell.SendKeys ("%{F4}") WScript.Sleep (1000) End If SourceFolders(0) = "System\" SourceFolders(1) = "SystemDllRegister\" SourceFolders(2) = "SystemExeRegister\" SourceFolders(3) = "Focke\" SourceFolders(4) = "CommonProgramFilesDllRegister\" For i=0 To 4 If Left(SourceFolders(i),6) = "System" Then strTargetFolder = fso.GetSpecialFolder(1) ElseIf SourceFolders(i) = "Focke\" Then strTargetFolder = ExpandPath("%Fockedir%","c:\Focke") ElseIf Left(SourceFolders(i),18) = "CommonProgramFiles" Then strTargetFolder = ExpandPath("%CommonProgramFiles%\Focke","c:\Program Files\Focke") End If CreateTargetFolder(strTargetFolder) strCurrentFolder = strPath & SourceFolders(i) Set CurrentFolder = fso.GetFolder(strCurrentFolder) Set AllFiles = CurrentFolder.Files For Each File in AllFiles bCopied = False strTargetFile = strTargetFolder & "\" & File.Name If Not fso.FileExists(strTargetFile) Then File.Copy(strTargetFile) bCopied = True Else set TmpFile = fso.GetFile(strTargetFile) strDateNew = File.DateLastModified strDateOrg = TmpFile.DateLastModified 'TmpFile = Nothing if strDateNew > strDateOrg Then On Error Resume Next Call File.Copy(strTargetFile) On Error Goto 0 If Err.Number = 0 Then bCopied = True Err.Clear End If 'MsgBox "File Exists " & file.Name End If If bCopied Then Select Case(i) Case 1 Call wshshell.Run("Regsvr32 /s """ & strTargetFile & """",1,True) Case 2 Call wshshell.Run("""" & strTargetFile & """ /regserver",1,True) Case 4 Call wshshell.Run("Regsvr32 /s """ & strTargetFile & """",1,True) End Select 'Schreibschutz aufheben Set FileAcc = fso.GetFile(strTargetFile) FileAcc.Attributes = FileAcc.Attributes And Not 216 And Not 1 End If Next Next '------------------------------- 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 '----------------------------------- Subs -------------------------------------- Sub CreateTargetFolder(p_strTargetFolder) If Not fso.FolderExists(p_strTargetFolder) Then On Error Resume Next Call fso.CreateFolder(p_strTargetFolder & "\") On Error Goto 0 End If End Sub