VBScript School Task Sixteen Programs In One

Do While True

parameter = InputBox("Vælg et Program:" & vbNewLine & vbNewLine & _
"1. Oprettelse af netværksdrev" & vbNewLine & _
"2. Slette netværksdrev" & vbNewLine & _
"3. Oprette adgang til netværksprinter" & vbNewLine & _
"4. Udskrive computernavn" & vbNewLine & _
"5. Opret Mappe på fx C:" & vbNewLine & _
"6. Slette en Mappe på fx C:" & vbNewLine & _
"7. Udskrive memory størrelse på computer" & vbNewLine & _
"8. Oprette mappe hvis den ikke er oprettet" & vbNewLine & _
"9. Opret en tekstfil i en mappe" & vbNewLine & _
"10. Kontroller om en fil eksisterer og opret den" & vbNewLine & _
"11. Tilføj data til en eksisterende fil" & vbNewLine & _
"12. Konverter alfabetet til Ascii" & vbNewLine & _
"13. Udskrive Windows version" & vbNewLine & _
"14. Ping kommando" & vbNewLine & _
"15. Traceroute kommando" & vbNewLine & _
"16. Udskriv dit fulde navn" & vbNewLine & _
"17. Afslut Program" & vbNewLine)

If parameter <> "" Then
        Select Case parameter
        Case 1
                Call Opgave1()
        Case 2
                Call Opgave2()
        Case 3
                Call Opgave3()
        Case 4
                Call Opgave4()
        Case 5
                Call Opgave5()
        Case 6
                Call Opgave6()
        Case 7
                Call Opgave7()
        Case 8
                Call Opgave8()
        Case 9
                Call Opgave9()
        Case 10
                Call Opgave10()
        Case 11
                Call Opgave11()
        Case 12
                Call Opgave12()
        Case 13
                Call Opgave13()
        Case 14
                Call Opgave14()
        Case 15
                Call Opgave15()
        Case 16
                Call Opgave16()
        Case 17
                WScript.Quit(0)
        Case Else
                MsgBox("Du skal vælge et tal mellem 1 og 17.")
        End Select
Else
        MsgBox("Du skal vælge et tal mellem 1 og 17")
End If
Loop

Sub Opgave1()

On Error Resume Next
Dim objNetwork, strUserName, strPassWord, strPer
Dim strDriveLetter, strRemotePath
strDriveLetter = "H:"
strRemotePath = "\\10.0.0.102\KlasseDrev\e311"
Set objNetwork = CreateObject("WScript.Network")
strPer = "FALSE"
strUserName = InputBox("Skriv Brugernavn:")
strPassWord = InputBox("Skriv Adgangskode:")
objNetwork.MapNetworkDrive strDriveLetter, strRemotePath, strPer, strUserName, strPassWord
If Err.Number <> 0 Then
        MsgBox Err.Description, vbOKOnly, "Der opstod en fejl"
Else
        MsgBox strDriveLetter & " Drevet er blevet mappet!", vbOKOnly, "Information"
End If
End Sub

Sub Opgave2()
Dim objShell, objNetwork, DriveLetter1, objFile
DriveLetter1 = "H:"
Set objFile = CreateObject("Scripting.FileSystemObject")
Set objNetwork = CreateObject("WScript.Network")
If objFile.DriveExists(DriveLetter1) Then
        objNetwork.RemoveNetworkDrive DriveLetter1
        MsgBox("Drevet " & DriveLetter1 & " er blevet slettet!")
Else
        MsgBox("Drevet " & DriveLetter1 & " kunne ikke findes!")
End If
End Sub

Sub Opgave3()
On Error Resume Next
Dim objNetwork, strUNCPrinter
strUNCPrinter = "\\10.0.0.104\tev-e-309a-prt1"
Set objNetwork = CreateObject("WScript.Network")
strPer = "true"
strUserName = InputBox("Skriv Brugernavn:")
strPassWord = InputBox("Skriv Adgangskode:")
objNetwork.AddWindowsPrinterConnection strUNCPrinter

If Err.Number <> 0 Then
        MsgBox "Der kunne ikke oprettes forbindelse til Skolens Printer." & vbNewLine & vbNewLine & _
        "Sørg for at have netværksadgang og angiv de rigtige login oplysninger!",,"Der opstod en fejl"
Else
        MsgBox "Printer: " & strUNCPrinter & vbNewLine & vbNewLine & "Forbindelse er blevet oprettet!"
End If
End Sub

Sub Opgave4()

Set wshShell = WScript.CreateObject( "WScript.Shell" )
strComputerName = wshShell.ExpandEnvironmentStrings( "%COMPUTERNAME%" )
Msgbox "Computernavn: " & strComputerName, vbOKOnly, "Information"

End Sub

Sub Opgave5()

Set objFile = CreateObject("Scripting.FileSystemObject")
If objFile.FolderExists("Opgave5") Then
        objFile.CreateFolder("Opgave5")
        MsgBox("Mappen Opgave5 er blevet oprettet!")
Else
        MsgBox("Mappen Opgave5 er oprettet allerede!")
End if

End Sub

Sub Opgave6()

Set objFSO = CreateObject("Scripting.FileSystemObject")
strFolder = InputBox("Skriv navnet på den mappe, som du vil slette?", "Slet en Mappe")
If Not Len(strFolder) = 0 Then
        If objFSO.FolderExists(strFolder) Then
                answer = MsgBox("Den angivet mappe eksisterer. Er du sikker på at du vil slette den?", vbYesNo, "Advarsel")
                If answer = vbYes Then
                        objFSO.DeleteFolder(strFolder)
                        MsgBox "Godt! Din mappe er blevet slettet!"
                        Exit sub
                End If
        End If
Else
        Exit sub
End If

End Sub

Sub Opgave7()
Set wshShell = WScript.CreateObject( "WScript.Shell" )
strUserComputer = wshShell.ExpandEnvironmentStrings("%COMPUTERNAME%")
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
Set colCSItems = objWMIService.ExecQuery("SELECT * FROM Win32_ComputerSystem")
For Each objCSItem In colCSItems
  intRamMB = int((objCSItem.TotalPhysicalMemory) / 1048576)+1
  msgbox "Computernavn: " & strUserComputer & vbNewLine & _
  "Totale Fysiske Hukommelse: " & intRamMB & " MB"
Next
End Sub

Sub Opgave8()

Do While True
Set objFSO = CreateObject("Scripting.FileSystemObject")
strFolder = InputBox("Skriv navnet på den mappe, som du vil oprette", "Opret Mappe")
If Not Len(strFolder) = 0 Then
        If objFSO.FolderExists(strFolder) Then
                MsgBox "Mappen eksisterer allerede! Prøv igen!", vbOKOnly, "Fejl"
        End If
        If Not objFSO.FolderExists(strFolder) Then
                objFSO.CreateFolder(strFolder)
                MsgBox "Mappen " & strFolder & " er blevet oprettet!", vbOKOnly, "Information"
                newfolder = MsgBox("Vil du oprette en mappe mere?", vbYesNo, "Spørgsmål")
                If newfolder = vbNo Then
                        MsgBox("Programmet Afsluttes!")
                        Exit sub
                End If
        End If
Else
        Exit sub
End If
Loop

End Sub

Sub Opgave9()
Const ForAppending = 8
Set objfile = CreateObject("Scripting.FileSystemObject")
If Not objfile.FolderExists("ScriptingMappe") Then
        Dim dirName
        dirName = "ScriptingMappe"
        Set objFolder = objfile.CreateFolder(dirName)
        Set strDir = objfile.GetFolder(dirName)
        Set writetofile = objfile.OpenTextFile(strDir & "\\" & "Opgave9.txt", ForAppending, True)
        writetofile.writeline("Det var en nem opgave :-)")
        writetofile.writeline()
        writetofile.writeline("Scripting med VBSCRIPT er sjovt!")
        writetofile.Close()
        If  objfile.FileExists(strDir & "\\" & "Opgave9.txt") Then
                MsgBox("Filen Opgave9.txt er blevet oprettet!")
        Else
                MsgBox "Filen Opgave9.txt blev ikke oprettet! Du har muligvis ikke rettigheder til at oprette filen.", vbOKOnly, "Fejl"
        End If
Else
        MsgBox("Du har kørt dette program før! Du kan slette mappen ScriptingMappe, og forsøge at køre programmet igen!")
End If
End Sub

Sub Opgave10()
Set objfile = CreateObject("Scripting.FileSystemObject")
If Not objfile.FileExists("Opgave10.txt") Then
        objfile.CreateTextFile("Opgave10.txt")
        MsgBox("Opgave10.txt er blevet oprettet!")
Else
        MsgBox("Filen Opgave10.txt eksisterer allerede!")
End If
Exit Sub
End Sub

Sub Opgave11()

Const ForAppending = 8
Set objfile = CreateObject("Scripting.FileSystemObject")
Set writetofile = objfile.OpenTextFile("Opgave11.txt", ForAppending, True)
writetofile.writeline("Det var en nem opgave :-)")
writetofile.writeline()
writetofile.writeline("Scripting med VBSCRIPT er sjovt!")
writetofile.Close()
MsgBox("Filen Opgave11.txt er blevet oprettet!")
Exit Sub

End Sub

Sub Opgave12()

On Error Resume Next
intSTal = 0
intETal = 9
MyArray = Array()
alphabet = "a:b:c:d:e:f:g:h:i:j:k:l:m:n:o:p:q:r:s:t:u:v:w:z:y:x"
minLength = Len(Replace(alphabet, ":", ""))
ReDim MyArray(minLength)
MyArray = Split(alphabet, ":")
GetTenPass = minLength/10
For x = 0 To GetTenPass
        For i = intSTal To intETal
                ascii = ascii & CStr(UCase(MyArray(i))) & " = " & Asc(UCase(MyArray(i))) & ", "
        Next
        ascii = Left(ascii, Len(ascii)-2)
        MsgBox ascii, vbOKOnly, "Information"
        intSTal = intSTal + 10
        intETal = intETal + 10
        ascii = ""
Next

End Sub

Sub Opgave13()

Dim objShell, objUNC, arrOS
Dim strVersion, strOS, strSP, strWinLogon
strOS = "ProductName"
strVersion ="CurrentVersion"
strSP = "CSDVersion"
strWinLogon = "HKLM\SOFTWARE\Microsoft\"_
& "Windows NT\currentVersion\"
Set objShell = CreateObject("WScript.Shell")
strOS = objShell.RegRead(strWinLogon & strOS)
arrOS = Split(strOS, " " )
strSP = objShell.RegRead(strWinLogon & strSP)
strVersion = objShell.RegRead(strWinLogon & strVersion)
MsgBox "Operativ System: " & strOS & " version " & strVersion & " " & strSP

End Sub

Sub Opgave14()

Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim pingdialog, shellstring, filename
filename = "ping.txt"
If objFSO.FileExists(filename) Then
        objFSO.DeleteFile(filename)
End If
Set logfile = objFSO.OpenTextFile(filename, 8, True)
Set objShell = CreateObject("Wscript.Shell")
pingdialog = InputBox("Skriv en IP Adresse Eller et DNS Navn:")
shellstring = "ping -n 4 " & pingdialog

Set oExec = objShell.Exec(shellstring)
Do While oExec.StdOut.AtEndOfStream <> True
        logfile.WriteLine(oExec.StdOut.ReadLine)
Loop

MsgBox("Programmet er færdig med at sende ICMP/ECHO forespørgsler! Resultatet er gemt i filen ping.txt")

End Sub

Sub Opgave15()

Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim pingdialog, shellstring, filename
filename = "trace.txt"
If objFSO.FileExists(filename) Then
        objFSO.DeleteFile(filename)
End If
Set logfile = objFSO.OpenTextFile(filename, 8, True)
Set objShell = CreateObject("Wscript.Shell")
pingdialog = InputBox("Skriv en IP Adresse Eller et DNS Navn:")
shellstring = "tracert " & pingdialog

Set oExec = objShell.Exec(shellstring)
Do While oExec.StdOut.AtEndOfStream <> True
        logfile.WriteLine(oExec.StdOut.ReadLine)
Loop

MsgBox("Programmet er færdig med at spore ruten til din destination. Resultatet er gemt i filen " & filename)

End Sub

Sub Opgave16()
fornavn = InputBox("Skriv dit fornavn:", "Opgave 16")
efternavn = InputBox("Skriv dit efternavn:", "Opgave 16")
If fornavn <> "" And efternavn <> "" Then
        fornavn = UCase(Left(fornavn, 1)) + Right(fornavn, Len(fornavn)-1)
Else
        MsgBox "Du skal skrive både fornavn og efternavn!", vbOKOnly, "Fejl"
        Exit Sub
End If
MsgBox fornavn & " " & efternavn
End Sub