datCloud

Never Gonna Give You Up.vb

Mar 24th, 2021
1,253
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. ' ==============================================Description =========================================
  2. ' This vbscript can play "Never Gonna Give You Up" ,From the Autor : "Rick Astley" in the background
  3. ' And can open in the same time the Notepad and Auto type "Never Gonna Give You Up Lyrics"
  4. ' Vbscript Rick_Roll.vbs Created by Hackoo on 24/03/2021
  5. ' ===================================================================================================
  6. Option Explicit
  7. Dim Rick_Roll_Lyrics
  8. Rick_Roll_Lyrics = "We're no strangers to love," & vbNewLine &_
  9.                 "You know the rules and so do I." & vbNewLine &_
  10.                 "A full commitment's what I'm thinking of," & vbNewLine &_
  11.                 "You wouldnt get this from any other guy." & vbNewLine &_
  12.                 "I just wanna tell you how I'm feeling," & vbNewLine &_
  13.                 "Gotta make you understand..." & vbNewLine &_
  14.                 "Never gonna give you up," & vbNewLine &_
  15.                 "Never gonna let you down," & vbNewLine &_
  16.                 "Never gonna run around and desert you." & vbNewLine &_
  17.                 "Never gonna make you cry," & vbNewLine &_
  18.                 "Never gonna say goodbye," & vbNewLine &_
  19.                 "Never gonna tell a lie and hurt you." & vbNewLine &_
  20.                 "We've known each other for so long" & vbNewLine &_
  21.                 "Your heart's been aching" & vbNewLine &_
  22.                 "But you're too shy to say it." & vbNewLine &_
  23.                 "Inside we both know what's been going on," & vbNewLine &_
  24.                 "We know the game and we're gonna play it." & vbNewLine &_
  25.                 "Annnnnd if you ask me how I'm feeling," & vbNewLine &_
  26.                 "Don't tell me you're too blind to see..." & vbNewLine &_
  27.                 "Never gonna give you up," & vbNewLine &_
  28.                 "Never gonna let you down," & vbNewLine &_
  29.                 "Never gonna run around and desert you." & vbNewLine &_
  30.                 "Never gonna make you cry," & vbNewLine &_
  31.                 "Never gonna say goodbye," & vbNewLine &_
  32.                 "Never gonna tell a lie and hurt you." & vbNewLine &_
  33.                 "Never gonna give you up," & vbNewLine &_
  34.                 "Never gonna let you down," & vbNewLine &_
  35.                 "Never gonna run around and desert you." & vbNewLine &_
  36.                 "Never gonna make you cry," & vbNewLine &_
  37.                 "Never gonna say goodbye," & vbNewLine &_
  38.                 "Never gonna tell a lie and hurt you." & vbNewLine &_
  39.                 "Give you up. give you up." & vbNewLine &_
  40.                 "Give you up, give you up." & vbNewLine &_
  41.                 "Never gonna give" & vbNewLine &_
  42.                 "Never gonna give, give you up." & vbNewLine &_
  43.                 "Never gonna give" & vbNewLine &_
  44.                 "Never gonna give, give you up." & vbNewLine &_
  45.                 "We've known each other for so long" & vbNewLine &_
  46.                 "Your heart's been aching" & vbNewLine &_
  47.                 "But you're too shy to say it." & vbNewLine &_
  48.                 "Inside we both know what's been going on," & vbNewLine &_
  49.                 "We know the game and we're gonna play it." & vbNewLine &_
  50.                 "I just wanna tell you how I'm feeling," & vbNewLine &_
  51.                 "Gotta make you understand..." & vbNewLine &_
  52.                 "Never gonna give you up," & vbNewLine &_
  53.                 "Never gonna let you down," & vbNewLine &_
  54.                 "Never gonna run around and desert you." & vbNewLine &_
  55.                 "Never gonna make you cry," & vbNewLine &_
  56.                 "Never gonna say goodbye," & vbNewLine &_
  57.                 "Never gonna tell a lie and hurt you." & vbNewLine &_
  58.                 "Never gonna give you up," & vbNewLine &_
  59.                 "Never gonna let you down," & vbNewLine &_
  60.                 "Never gonna run around and desert you." & vbNewLine &_
  61.                 "Never gonna make you cry," & vbNewLine &_
  62.                 "Never gonna say goodbye," & vbNewLine &_
  63.                 "Never gonna tell a lie and hurt you." & vbNewLine &_
  64.                 "Never gonna give you up," & vbNewLine &_
  65.                 "Never gonna let you down," & vbNewLine &_
  66.                 "Never gonna run around and desert you." & vbNewLine &_
  67.                 "Never gonna make you cry," & vbNewLine &_
  68.                 "Never gonna say goodbye," & vbNewLine &_
  69.                 "Never gonna tell a lie and hurt you."
  70. '--------------------------------Main()------------------------------------
  71. If Check_Internet_Connection = True Then
  72.     Call Play_Rick_Roll_Music()
  73. End If
  74. Call Pause(20)
  75. Call AutoTypeWriter(Rick_Roll_Lyrics)
  76. '--------------------------------------------------------------------------
  77. Sub Pause(s)
  78.     Wscript.Sleep(s*1000)
  79. End Sub
  80. '--------------------------------------------------------------------------
  81. Sub AutoTypeWriter(strText)
  82.     Dim intPause,Ws,intTextLen,x,strTempText
  83.     intPause = 80
  84.     Set Ws = CreateObject("WScript.Shell")
  85. 'To start Notepad maximized
  86.     Ws.Run "Notepad",3
  87.     WScript.Sleep 1000
  88.     intTextLen = Len(strText)
  89.     For x = 1 to intTextLen
  90.         strTempText = Mid(strText,x,1)
  91.         Ws.Sendkeys strTempText
  92.         WScript.Sleep intPause
  93.     Next
  94. End Sub
  95. '----------------------------------------------------------------------------------------
  96. Sub Play_Rick_Roll_Music()
  97.     Dim WS,oWSF,fso,Temp,WSF_File,URL_Music,CMD
  98.     Set WS = CreateObject("wscript.Shell")
  99.     Set fso = CreateObject("Scripting.FileSystemObject")
  100.     Temp = WS.ExpandEnvironmentStrings("%Temp%")
  101.     WSF_File = Temp & "\Rick_Roll_Music.vbs"
  102.     Set oWSF = fso.OpenTextFile(WSF_File,2,True)
  103.     oWSF.WriteLine  "Dim Sound"
  104.     oWSF.WriteLine  "Set Sound = CreateObject(""WMPlayer.OCX"")"
  105.     oWSF.WriteLine  "Sound.URL = ""http://www.leeholmes.com/projects/ps_html5/background.mp3"""
  106.     oWSF.WriteLine  "Sound.settings.volume = 100"
  107.     oWSF.WriteLine  "Sound.Controls.play"
  108.     oWSF.WriteLine  "While Sound.playState <> 1"
  109.     oWSF.WriteLine      "WScript.Sleep 100"
  110.     oWSF.WriteLine  "Wend"
  111.     oWSF.Close
  112.     CMD = "wscript.exe " & DblQuote(WSF_File) & ""
  113.     WS.RUN CMD,0,False
  114. End Sub
  115. '----------------------------------------------------------------------------------------
  116. Function DblQuote(Str)
  117.     DblQuote = Chr(34) & Str & Chr(34)
  118. End Function
  119. '----------------------------------------------------------------------------------------
  120. Function Check_Internet_Connection()
  121. Dim MyLoop,strComputer,objPing,objStatus,ws
  122. Set ws = CreateObject("wscript.shell")
  123. MyLoop = True
  124. While MyLoop
  125.     strComputer = "smtp.gmail.com"
  126.     Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}!\\").ExecQuery _
  127.     ("select * from Win32_PingStatus where address = '" & strComputer & "'")
  128.     For Each objStatus in objPing
  129.         If objStatus.Statuscode = 0 Then
  130.             MyLoop = False
  131.             Check_Internet_Connection = True
  132.             Exit for
  133.         Else
  134.             ws.run "%SystemRoot%\system32\msdt.exe -skip TRUE -path %Windir%\diagnostics\system\networking -ep NetworkDiagnosticsPNI"
  135.         End If
  136.     Next
  137.     Pause(10) 'To sleep for 10 secondes
  138. Wend
  139. End Function
  140. '--------------------------------------------------------------------------------------
RAW Paste Data