'*** v3.B*** www.dieseyer.de *******************************
'
' Datei:  linkinsendto.vbs
' Autor:  dieseyer@gmx.de 
' Auf:    www.dieseyer.de
'
' Befindet sich die Function-Prozedur 'AutoStartLink' in einem
' Skript, wird 
' 
' beim ersten Aufruf 
' - das Skript in den Ordner "c:\programme\dieseyer.de\" kopiert
' - ein Link (mit '-Install'-Parameter) zu diesem Skript im 
'   Autostart-Ordner (All Users) angelegt, damit nach der 
'   User-Anmeldung ein Link im (User abhängigen) 'SendTo'
'   -Ordner eingefügt wird.
' - ein Link zu diesem Skript im 'SendTo'-Ordner (des zur Zeit 
'   angemeldeten User) angelegt.
' 
' beim Aufruf durch Autostart
' - (mit '-Install'-Parameter) wird ein Link zu diesem Skript im
'   'SendTo'-Ordner (des zur Zeit angemeldeten User) angelegt.
' 
' beim Aufruf durch 'Senden an' bzw. 'SendTo':
'   Man kann jetzt im Explorer Datei(en) markieren (und dann 
'   durch Klicken mit der rechten Maus-Taste und über 'Senden 
'   an') die markierten Dateien an das Skript übergeben.
' 
'***********************************************************

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

Dim i, Text, oArgs, SendToLink 
Set oArgs     = Wscript.Arguments ' Argumente bereit stellen

SendToLink = "TEST Link In SendToText"

' Argumente testen/holen 
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If oArgs.Count = 0 then SkriptInfo SendToLink ' SUB Aufruf
'                       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

For i = 0 to oArgs.Count - 1     ' hole alle Argumente 
  if i = 0 then
       Text = Left( UCase(oArgs.item(i)), 2) 
    if Text = "-S" OR Text = "-I" then AutoStartLink ( SendToLink ) ' Function  Aufruf
'                                      ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'   Skript wurde mit Parameter "-S" oder "-I" (bzw. -setup oder -install)
'   aufgerufen; die AutoStartLink-Prozedur endet mit WScript.Quit
  End If

      ReDim Preserve arrTest(i) 
                     arrTest(i) = oArgs.item(i)
Next
 
' arrSort = bubblesort(arrTest)              ' function - Aufruf 
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
 
    Text = "Folgende Argumente wurden an das Skript übergeben:"
  for i = 0 to ubound(arrTest) 
    Text = Text & vbCRLF & vbTab & i+1 & ". Argument: " & arrTest(i) 
  next 

MsgBox Text, , WScript.ScriptName

WScript.Quit


'*** v3.B*** www.dieseyer.de *******************************
Sub SkriptInfo( SendToLink )
'***********************************************************
Dim Text
Dim WSHShell
Set WSHShell  = WScript.CreateObject("WScript.Shell")

  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( SendToLink )


'*** v3.B*** www.dieseyer.de *******************************
Function AutoStartLink( SendToLink )
'***********************************************************
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 )