'*** v3.B *** www.dieseyer.de ******************************* 

' 

' Datei:  attributechange.vbs 

' Autor:  dieseyer@gmx.de  

' Auf:    www.dieseyer.de 

' 

' Setzt die Attribute aller Dateien in dem übergebenen  

' Verzeichnis zurück. 

' 

'************************************************************ 

 

Option Explicit ' Siehe http://dieseyer.de/dse-wsh-lernen.html#OptionExpl 

 

Dim SendToLink, Text, Txt, TextX, i, lang 

Dim WSHShell, fso, oArgs, ShellLink 

 

Set WSHShell = WScript.CreateObject("WScript.Shell") 

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

set oArgs    = Wscript.Arguments  

 

SendToLink = "Attribute ändern" 

 

' Argumente testen/holen  

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 

 

If oArgs.Count = 0 then SkriptInfo ' SUB Aufruf 

'                       ~~~~~~~~~~~~~~~~~~~~~~~~~ 

 

'*************************************************************** 

' ANFANG - Das eigentliche Skript beginnt 

'*************************************************************** 

 

lang = 0 

 

For i = 0 to oArgs.Count - 1     ' hole alle Argumente  

 

lang = lang + Len(oArgs.item(i)) 

 

  if i = 0 then 

       Text = Left( UCase(oArgs.item(i)), 2)  

    if Text = "-S" OR Text = "-I" then AutoStartLink ( SendToLink ) ' Function  Aufruf 

'   if Text = "-S" OR Text = "-I" then SendenAnLink ' Sub Aufruf 

'                                      ~~~~~~~~~~~~~~~~~~~~~~~~~ 

       Text = "" 

  End If 

   

'  On Error Resume Next 

     if fso.FileExists(   oArgs.item(i) ) then TextX = "%comspec% /c Attrib.exe """ & oArgs.item(i) & """ -s -r -h " 

'    if fso.FolderExists( oArgs.item(i) ) then TextX = "%comspec% /c Attrib """     & oArgs.item(i) & "\*.*"" -s -r -h /s" 

'    if fso.FolderExists( oArgs.item(i) ) then TextX = "%comspec% /c Attrib """     & oArgs.item(i) & "\*.*"" -s -r -h /s" 

     if fso.FolderExists( oArgs.item(i) ) then TextX = "%comspec% /c Attrib.exe """ & oArgs.item(i) & "\*.*"" -s -r -h /s" 

'      WSHShell.Popup TextX, 10, WScript.ScriptName , 64  

       WSHShell.run TextX , 4, True 

'      WSHShell.run TextX , , True 

'  On Error GoTo 0 

 

  Text = Text & i & "   " & TextX & vbCRLF  

Next  

 

'*************************************************************** 

' ENDE - das eigentliche Skript endet 

'*************************************************************** 

 

  Text = Replace(Text, "%comspec% /c", "") 

  Text = Replace(Text, "Attrib.exe", "attrib") 

 

WSHShell.Popup Text, 10, WScript.ScriptName & " . . . ist zu Ende. (" & lang & ")" , 64  

 

WScript.Quit 

 

'********************************* 

Sub SkriptInfo ' Sub Aufruf 

'********************************* 

 

  Text = "" 

  Text = Text & "Das ganze funktioniert so:" & vbCRLF & vbCRLF  

  Text = Text & "Entweder ein oder mehrere Dateien bzw. Verzeichnisse " & vbCRLF  

  Text = Text & "mit der Maus auf das Skript ziehen und fallen lassen, " & vbCRLF  

  Text = Text & "oder dem Skript über 'Senden an' die Dateien bzw. " & vbCRLF  

  Text = Text & "Verzeichnisse übergeben. " & vbCRLF & vbCRLF  

  Text = Text & "Soll das Skript über 'Senden an' (SendTo) erreichbar sein?"  & vbCRLF  

 

  If not vbYes = WSHShell.Popup (Text , 30, WScript.ScriptName, 32 + 4  ) then  

    WSHShell.Popup " . . . dann eben nicht!", 10, WScript.ScriptName & " . . . ist zu Ende." , 48  

    WScript.Quit 

  End If 

 

  Text = "" 

  Text = Text & "Das Skript   " & UCase( WScript.ScriptName ) & "   wird jetzt für alle Benutzerkonten " & vbCRLF  

  Text = Text & "oder, wenn das nicht geht, für den angemeldeten Benutzer  " & vbCRLF  

  Text = Text & "unter   'Senden an'   eingerichtet." & vbCRLF & vbCRLF  

  Text = Text & "Es ist dann als   '" & SendToLink & "'   verfügbar." 

  WSHShell.Popup Text, 10, WScript.ScriptName , 64  

 

  AutoStartLink ( SendToLink ) ' SUB Aufruf 

' ~~~~~~~~~~~~~~~~~~~~~~~~~~~ 

 

  WScript.Quit 

 

End Sub ' SkriptInfo 

 

 

'*************************************************************** 

Function AutoStartLink( SendToLink ) ' Function Aufruf 

'*************************************************************** 

Dim Text, TextX, ShellLink 

Dim WSHShell, fso 

 

Set WSHShell = WScript.CreateObject("WScript.Shell") 

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

 

 

' wohin soll das Skript kopiert werden? 

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 

' folgende Zeile müsste    c:\    ergeben 

  Text  = Left( WSHShell.ExpandEnvironmentStrings("%WinDir%") , 3)   

 

  if fso.FolderExists( WSHShell.ExpandEnvironmentStrings("%Temp%") ) then TextX = WSHShell.ExpandEnvironmentStrings("%Temp%")  

  if fso.FolderExists( Text & "PROGRAM FILES" )                      then TextX = Text & "PROGRAM FILES"  

  if fso.FolderExists( Text & "programme" )                          then TextX = Text & "programme"  

 

  TextX = TextX & "\dieseyer.de"  

 

  On Error Resume Next 

    if not fso.FolderExists( TextX ) then fso.CreateFolder( TextX )  

  On Error GoTo 0 

 

  if not fso.FolderExists( TextX ) then  

    WSHShell.Popup TextX & "    konnte nicht angelegt werden!" , 30, WScript.ScriptName & " . . . ist zu Ende!" , 64  

    WScript.Quit 

  End If 

 

' das Skript kopieren 

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 

  TextX = TextX & "\" & SendToLink & ".vbs" 

 

' das Skript kopieren, wenn das Zielskript nicht das aktuelle, 

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 

' laufende Skript ist 

  If not LCase(TextX) = LCase(WScript.ScriptFullName) then 

    On Error Resume Next 

      fso.CopyFile WScript.ScriptName, TextX , True  

      if not err.number = 0 then  

        WSHShell.Popup TextX & "    konnte nicht angelegt werden!" , 30, WScript.ScriptName & " . . . ist zu Ende!" , 64  

        WScript.Quit 

      End If 

    On Error GoTo 0 

  End If 

 

 

' Link in 'Autostart' von 'All Users' installieren ... 

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 

' ... der wird dann bei jedem Aufruf den 'Senden An' - Link erstellen 

 

  Text = WSHShell.SpecialFolders("AllUsersStartup") & "\" & SendToLink & ".lnk" 

  If Text = "\" & SendToLink & ".lnk"  then           ' bei Win9x 

    Text = WSHShell.SpecialFolders("Startup") & "\" & SendToLink & ".lnk" 

  End If 

 

  Set ShellLink              = WSHShell.CreateShortcut( Text) 

  ShellLink.TargetPath       = TextX  

  ShellLink.Arguments        = "-install" 

  ShellLink.WorkingDirectory = fso.GetParentFolderName( TextX ) 

 

  On Error Resume Next 

    ShellLink.Save 

  On Error GoTo 0 

 

  If not err.number = 0 then 

    WSHShell.Popup Text & "    konnte nicht angelegt werden!" , 30, WScript.ScriptName , 64  

  End If 

 

  Text = WSHShell.SpecialFolders("SendTo") & "\" & SendToLink & ".lnk" 

 

       Set ShellLink              = WSHShell.CreateShortcut( Text) 

       ShellLink.TargetPath       = TextX  

       ShellLink.WorkingDirectory = fso.GetParentFolderName( TextX ) 

'      ShellLink.Save  =======>  kommt später 

 

    On Error Resume Next 

 

      if fso.FileExists( Text ) then  

'        WSHShell.Popup Text & "    wird überschrieben!" , 10, WScript.ScriptName , 64  

 

        ShellLink.Save ' =======>  kommt hier 

          If err.number = 0 then 

'           WSHShell.Popup Text & "    wurde überschrieben!" , 10, WScript.ScriptName , 64  

          Else 

            WSHShell.Popup Text & "    konnte nicht überschrieben werden!" , 30, WScript.ScriptName , 64  

          End If 

      Else 

 

        ShellLink.Save ' =======>  kommt hier 

          If err.number = 0 then 

'           WSHShell.Popup Text & "    wurde angelegt!" , 10, WScript.ScriptName , 64  

          Else 

            WSHShell.Popup Text & "    konnte nicht angelegt werden!" , 30, WScript.ScriptName , 64  

          End If 

      End If 

    On Error GoTo 0 

 

  WScript.Quit 

 

End Function ' AutoStartLink ( SendToLink )  

'***************************************************************