Jump to content

Welcome to MSFN Forum
Register now to gain access to all of our features. Once registered and logged in, you will be able to create topics, post replies to existing threads, give reputation to your fellow members, get your own private messenger, post status updates, manage your profile and so much more. This message will be removed once you have signed in.
Login to Account Create an Account


Photo

Trying to migrate 2 VBScripts into one.

- - - - -

  • Please log in to reply
30 replies to this topic

#26
bphlpt

bphlpt

    MSFN Addict

  • Members
  • PipPipPipPipPipPipPip
  • 1,629 posts
  • OS:none specified
  • Country: Country Flag

I'll accept at least part of the blame for getting Win7 "involved" in this thread when it would seem the script is supposed to be used on an XP system to change the XP product key.
 
I don't have an XP system to use for testing, but I figured that I could at least see if the logic used in the OP VBS seemed to function.  So I tried it in my Win7 system, specified that I was using Win7 in my test, and specified that I cancelled the script without executing the Key Changer portion, but it did seem to bring it up appropriately once I added the "missing" last line of the script.  I did this test since the original complaint was that he couldn't seem to get past the Admin rights check portion.  I reported that I could so I didn't understand why the problem was occurring.
 
If my testing methods confused the issue I apologize.

 

EDIT:  Thanks to jaclaz for finding the following:
 
http://www.imdb.com/...?item=qt0320188
 

I do, I offer a complete and utter retraction. The imputation was totally without basis in fact, and was in no way fair comment, and was motivated purely by malice, and I deeply regret any distress that my comments may have caused you, or your family, and I hereby undertake not to repeat any such slander at any time in the future.


Cheers and Regards


Edited by bphlpt, 10 April 2014 - 08:00 PM.



How to remove advertisement from MSFN

#27
jaclaz

jaclaz

    The Finder

  • Developers
  • 13,393 posts
  • OS:none specified
  • Country: Country Flag

If my testing methods confused the issue I apologize.
 
http://www.imdb.com/...?item=qt0320188
 

I do, I offer a complete and utter retraction. The imputation was totally without basis in fact, and was in no way fair comment, and was motivated purely by malice, and I deeply regret any distress that my comments may have caused you, or your family, and I hereby undertake not to repeat any such slander at any time in the future.

Hmmm :unsure:, I wonder where exactly you found that link and quote ;).

:lol:

 

jaclaz



#28
bphlpt

bphlpt

    MSFN Addict

  • Members
  • PipPipPipPipPipPipPip
  • 1,629 posts
  • OS:none specified
  • Country: Country Flag

:)  Thought you would like that.

 

Cheers and Regards



#29
gunsmokingman

gunsmokingman

    MSFN Master

  • Super Moderator
  • 2,418 posts
  • OS:none specified
  • Country: Country Flag
1:\ Thanks to Jaclaz for pointing the correct WMI object
2:\ Tested this on Windows 7 as admin and as User, works I had to supply the admin stuff threw UAC GUI, with no errors.
3:\ Tested this same way on Windows Vista no errors.

RunAsKeyChanger.vbs
'-> Script By Gunsmokingman AKA Jake1Eye
'->   This Script And Or Any Code Is The Property Of Gunsmokingman Or
'->  Jake1Eye, Except Where Acknowledgement Comments Exists for Code
'->  Written By Other Coders.
'->   If Any Part Of This Code Is Used In Other Coding Project, There
'->  Must Be An Acknowledgement Comments To The Original Coder Must Be 
'->  Included In Any Other Coding Project.
'-> Objects For Runtime
 Dim Wmi :Set Wmi = GetObject("winmgmts:\\.\root\cimv2")
'-> Varible For RunTime
 Dim A, Obj, R
'-> Original Link To Script At StackOverFlow
'-> http://stackoverflow.com/questions/18504036/is-is-possible-to-have-run-as-prompt-for-vbscript
'-> Script Modified By Gunsmokingman Aka Jake1eye   
 Set reg = GetObject("winmgmts://./root/default:StdRegProv")
   rc = reg.GetStringValue(&h80000003, "S-1-5-19\Environment", "TEMP", val)
  If rc = 5 Then
'-> return code 5 == access denied, re-launch script only when it was run without arguments, 
'-> so we don't goin circles when admin privileges can't be acquired
  If WScript.Arguments.Count = 0 Then
'-> re-launch as administrator; the additional argument is a guard to make
'-> sure the script is re-launched only once
   CreateObject("Shell.Application").ShellExecute "wscript.exe" _
    , Chr(34) & WScript.ScriptFullName & Chr(34) & " relaunch", "", "runas", 1
   WScript.Quit 0
  Else
   Msgbox "Cannot acquire admin privileges.",4128,"Admin Access denied"
   WScript.Quit 1
  End If
  Else
'-> Code Here To Run Elevated
   Input()
   ConfirmChange(A)
  End If
'-> Function To Get The New Replace Key
   Function Input() 
    Input=InputBox( _
     "Type In The New Key In This Format 12345-54321-12345-ABCDE-1A2B3.") 
    If Len(Input) = 29 Then A = Input
     If Not Len(Input) = 29 Then   
      If MsgBox( _
      "Does Not Appear To Have 29 Characters : " & Len(Input) & vbCrLf & _
      "Would You Like To Redo Your Input, Yes To Redo," & vbCrLf & _
      "No To Exit And Do Nothing?",4132,"Redo Or Quit") = 6 Then
      Input()           
     Else     
      WScript.Quit 
     End If 
    End If 
   End Function   
 '-> Confirm The Changes
   Function ConfirmChange(K)
    Dim Os
    If MsgBox( _
     "Did you want to continue with changing the OS Product Key?" & vbCrLf & _
     "Yes to continue and change the OS Product Key, No to exit" & vbCrLf & _
     "and make no changes to the OS Product Key",4132,"Continue Or Stop") = 6 Then
     For Each Obj In Wmi.ExecQuery("SELECT * FROM win32_OperatingSystem")
       Os = Obj.Caption
      Next      
      If InStr(1,Os,"XP",1) Then OsX(Replace(K,"-","")) 
      If InStr(1,Os,"7",1) Or InStr(1,Os,"Vista",1)Then V7(K)
    Else     
     WScript.Quit      
    End If   
   End Function 
'-> Original Link To Script At PasteBin
'-> http://pastebin.com/Wp5cCsHk
'-> Script Modified By Gunsmokingman Aka Jake1eye
'-> For XP
   Function OsX(K)
    On Error Resume Next
     For Each Obj In Wmi.ExecQuery("SELECT * FROM win32_WindowsProductActivation")
      R = Obj.SetProductKey(K)
      If Err = 0 Then MsgBox "Key Has Been Change",4128,"Success"
      If Err <> 0 Then MsgBox "An Error entering the new OS Product Key" & vbCrLf & _
      "Key Enter : " & K & vbCrLf & "Verify that this is the correct or valid" & vbCrLf & _
      "OS Product Key",4128,"Key Error"
     Next   
   End Function
'-> Tested On Win 7 And Vista
   Function V7(K)
    For Each Obj In Wmi.ExecQuery("SELECT * FROM SoftwareLicensingService")      
     R = Obj.InstallProductKey(K)
     If Err = 0 Then MsgBox "Key Has Been Change",4128,"Success"
     If Err <> 0 Then MsgBox "An Error entering the new OS Product Key" & vbCrLf & _
      "Key Enter : " & K & vbCrLf & "Verify that this is the correct or valid" & vbCrLf & _
      "OS Product Key",4128,"Key Error"
    Next 
   End Function      
Rename RunAsKeyChanger.vbs.txt to RunAsKeyChanger.vbs to make active
Attached File  RunAsKeyChanger.vbs.txt   3.8KB   8 downloads

#30
Jeffery

Jeffery
  • Members
  • 9 posts
  • OS:Windows 7 x64
  • Country: Country Flag

gunsmokingman, i test your script on Windows XP and it is working without any problems. :thumbup

Adding this 2 scripts together looks more complicated than i expected it to be. :wacko:


Edited by Jeffery, 11 April 2014 - 01:14 AM.


#31
gunsmokingman

gunsmokingman

    MSFN Master

  • Super Moderator
  • 2,418 posts
  • OS:none specified
  • Country: Country Flag
One of the problems I had was how the New OS Key was processed by Win 7 and Vista, if
you removed the dash between the 5 characters it would cause an error. If you leave the
dashes in then it ran without errors, that why in the V7 function there is no On Error
Resume Next.

It was not that it was hard to figure out how to merge the 2 scripts, when you break it
down to separate functions.

Thank you and I was glad to help getting the script to work.

Here is a VBS script that meant to have One File Drag Drop or Use in Cmd Line
with One File, to be run with Admin Access.
 RunAsDragDrop.vbs
'-> Script By Gunsmokingman AKA Jake1Eye
'->   This Script And Or Any Code Is The Property Of Gunsmokingman Or
'->  Jake1Eye, Except Where Acknowledgement Comments Exists for Code
'->  Written By Other Coders.
'->   If Any Part Of This Code Is Used In Other Coding Project, There
'->  Must Be An Acknowledgement Comments To The Original Coder Must Be 
'->  Included In Any Other Coding Project.
'-> Objects For Runtime
 Dim Act :Set Act = CreateObject("Wscript.Shell")
 Dim Fso :Set Fso = CreateObject("Scripting.FileSystemObject")
 Dim Reg :Set Reg = GetObject("winmgmts://./root/default:StdRegProv")
'-> Varibles For Various Run Time
 Dim A, c34, Ts, Txt
  c34 = Chr(34)
  Txt = Act.ExpandEnvironmentStrings("%Temp%\DragDropItem.txt")
'-> Makes Sure One Item Has Been Drag And Drop Or Cmd Lines Arguments
 A = WScript.Arguments.Count
  If A = 0 Then 
   call Msg("You Must Drag And Drop One File" & vbCrLf & _
   "Type On To This Script.", "Error No File Drop")
   WScript.Quit(0)
  ElseIf A >= 2 Then 
   call Msg("This Script Only Allow For One File To" & vbCrLf & _
   "Be Drag And Drop. Total Files Drag And Drop : " & A,"Errpr To Many Files")
   WScript.Quit(1)
  End If 
'-> Original Link To Script At StackOverFlow
'-> http://stackoverflow.com/questions/18504036/is-is-possible-to-have-run-as-prompt-for-vbscript
'-> Script Modified By Gunsmokingman Aka Jake1eye 
  If Reg.GetStringValue(&h80000003, "S-1-5-19\Environment", "TEMP", val) = 5 Then
   If WScript.Arguments.Count = 1 Then
    MkT(WScript.Arguments.Item(0))
    CreateObject("Shell.Application").ShellExecute "wscript.exe" _
      , Chr(34) & WScript.ScriptFullName & Chr(34) & " relaunch", "", "runas", 1
    WScript.Quit(2)
    Else
     call Msg("Can Not Acquire Admin Privileges", "Error No Admin Access")
     WScript.Quit(3)
    End If
   Else
'-> Code Here With Admin Access
    Set Ts = Fso.OpenTextFile(Txt)
     A=Ts.ReadAll 
     Ts.Close()
    Act.Run(A),1,True 
   Fso.DeleteFile(Txt),True   
  End If
'-> Makes Text File With WScript.Arguments.Item(0) Passed On
'-> As Varible To Run With Admin Access
   Function MkT(T)  
    Set Ts = Fso.CreateTextFile(Txt)
    Ts.WriteLine c34 & T & c34
    Ts.Close()  
   End Function
'-> Makes All The Msgbox For The Script
   Function Msg(T, L)   
    MsgBox T, 4128, L
   End Function
Rename RunAsDragDrop.vbs.txt to RunAsDragDrop.vbs to make active
Attached File  RunAsDragDrop.vbs.txt   2.31KB   5 downloads




0 user(s) are reading this topic

0 members, 0 guests, 0 anonymous users



How to remove advertisement from MSFN