'*** 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 ) 
'***************************************************************