Jump to content

VBScript to AutoIt Converter

bkemmler
 Share

Recommended Posts

craigey1 Seeker

craigey1

Posted
Posted (edited)

Hi,

The script doesnt seem to handle the Following:

turbine_file = "turbineresources.properties"
turbine_file_path = "c:\mydir\webapp\web-inf\conf\"
drivelet = ""
Set fso = CreateObject("Scripting.FileSystemObject")
Dim Drive, AllDrives
Set fsObj = CreateObject("Scripting.FileSystemObject")
Set AllDrives = fso.Drives

dim drivelet_arr(10)
Found = 0
For Each Drive in AllDrives

If Drive.DriveType = 2 Then
Set filesystem = CreateObject("Scripting.FileSystemObject")
If filesystem.FileExists(Drive.DriveLetter+":\"+turbine_file_path+turbine_file) Then
found = found+1
drivelet_arr(found) = Drive.DriveLetter
end if
end if
Next

Set Drive = nothing
Set AllDrives = nothing
set fso = nothing
set filesystem = Nothing

I'm sure I can use the "DriveGetType" in AutoIt to get the same info into the array, but is it possible to get the converter program updated to do this automatically.

Thanks

Edited by craigey1
Link to comment
Share on other sites
  • Replies 93
  • Created
  • Last Reply

Top Posters In This Topic

Top Posters In This Topic

Popular Posts

bkemmler
bkemmler

This is a converter for a VBScript (5.6) to AutoIt (3.1.1) converter. i hope it is useful. There are many thinks to add at the moment. To test it you need all attach files. Comments are welcome.

Zedna
Zedna

I did syntax correction for current AutoIt 3.2.12.1 Not tested. VAConvert.04corrected.zip

BrewManNH
BrewManNH

This script is almost 8 years old, the language has changed in that time. RunErrorsFatal has been removed from the options, you need to delete that line.

  • 1 month later...
jarod Seeker

jarod

Posted
Posted

I am attempting to convert the DST update vbscript from Microsoft to Autoit so that I can automate a rollout but i am getting errors ... Can anyone give me a hand with this?

Here is the VBS:

----------------------

' SetDSTDates2207.vbs

' This script is used to set the start date and end date for the Daylight

' Saving Time date changes for 2007 and beyond. This script will update the

' DST dates for the twelve time zones as those time zones that are updated

' by the Microsoft's DST patch in KB931836 revised on February 7, 2007.

' This script is used for a GUI-mode execution.

' Version: 2.2.0.7

Option Explicit

' Declare global variables.

Dim strScriptName, strComputer

' Define variable for the script name.

strScriptName = "Daylight Saving Time Update"

' Obtain the local computer name.

strComputer = CreateObject("Wscript.Network").ComputerName

' Execute the RuntheScript sub routine.

RuntheScript strComputer

' Sub routine to run the script.

Private Sub RunTheScript(strComputer)

Dim strSetDST

' Run the setDSTValue function to set the new DST dates.

strSetDST = setDSTValue(strComputer)

' Print the message on the screen.

If strSetDST = "Success" Then

PrintMsg "Daylight Saving Time dates on " & strComputer & " have been updated successfully." & Space(5)

ElseIf strSetDST = "Already updated" Then

PrintMsg "Daylight Saving Time dates were already updated on " & strComputer & "." & Space(5)

Else

PrintMsg "Daylight Saving Time update failed on " & strComputer & "." & Space(5)

End If

End Sub

' Function to set the new DST dates.

Private Function setDSTValue(ByVal strComputer)

Dim strKeyPath01, strKeyPath02, strKeyPath03, strKeyPath04, strKeyPath05

Dim strKeyPath06, strKeyPath07, strKeyPath08, strKeyPath09, strKeyPath10

Dim strKeyPath11, strKeyPath12, strValueName1, strKeyPath13, strValueName2

Dim strKeyPath14, strValueName3, arrDST01, arrDST02, arrDST03, arrDST04

Dim arrDST05, arrDST06, arrDST07, arrDST08, arrDST09, arrDST10, arrDST11

Dim arrDST12, arrDSTSSValue, arrDSTDSValue, strDSTTZComp01, strDSTTZComp02

Dim strDSTTZComp03, strDSTTZComp04, strDSTTZComp05, strDSTTZComp06, strDSTTZComp07

Dim strDSTTZComp08, strDSTTZComp09, strDSTTZComp10, strDSTTZComp11, strDSTTZComp12

Dim strDSTSSComp, strDSTDSComp, strCompValue, strSetDST01, strSetDST02, strSetDST03

Dim strSetDST04, strSetDST05, strSetDST06, strSetDST07, strSetDST08, strSetDST09

Dim strSetDST10, strSetDST11, strSetDST12, strSetDST13, strSetDST14, strUpdateCheck

' Define variables for the registry key paths and value names.

strKeyPath01 = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Time Zones\Alaskan Standard Time"

strKeyPath02 = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Time Zones\Atlantic Standard Time"

strKeyPath03 = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Time Zones\Central Brazilian Standard Time"

strKeyPath04 = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Time Zones\Central Standard Time"

strKeyPath05 = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Time Zones\E. South America Standard Time"

strKeyPath06 = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Time Zones\Eastern Standard Time"

strKeyPath07 = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Time Zones\Iran Standard Time"

strKeyPath08 = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Time Zones\Israel Standard Time"

strKeyPath09 = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Time Zones\Mountain Standard Time"

strKeyPath10 = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Time Zones\Newfoundland Standard Time"

strKeyPath11 = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Time Zones\Pacific Standard Time"

strKeyPath12 = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Time Zones\W. Australia Standard Time"

strValueName1 = "TZI"

strKeyPath13 = "SYSTEM\CurrentControlSet\Control\TimeZoneInformation"

strValueName2 = "StandardStart"

strKeyPath14 = "SYSTEM\CurrentControlSet\Control\TimeZoneInformation"

strValueName3 = "DaylightStart"

' Define variables for the twelve binary DST settings.

' Alaskan Standard Time.

arrDST01 = Array(&H1C,&H02,&H00,&H00,&H00,&H00,&H00,&H00,&HC4,_

&HFF,&HFF,&HFF,&H00,&H00,&H0B,&H00,&H00,&H00,&H01,_

&H00,&H02,&H00,&H00,&H00,&H00,&H00,&H00,&H00,&H00,_

&H00,&H03,&H00,&H00,&H00,&H02,&H00,&H02,&H00,&H00,_

&H00,&H00,&H00,&H00,&H00)

' Atlantic Standard Time.

arrDST02 = Array(&HF0,&H00,&H00,&H00,&H00,&H00,&H00,&H00,&HC4,_

&HFF,&HFF,&HFF,&H00,&H00,&H0B,&H00,&H00,&H00,&H01,_

&H00,&H02,&H00,&H00,&H00,&H00,&H00,&H00,&H00,&H00,_

&H00,&H03,&H00,&H00,&H00,&H02,&H00,&H02,&H00,&H00,_

&H00,&H00,&H00,&H00,&H00)

' Central Brazilian Standard Time.

arrDST03 = Array(&HF0,&H00,&H00,&H00,&H00,&H00,&H00,&H00,&HC4,_

&HFF,&HFF,&HFF,&H00,&H00,&H02,&H00,&H00,&H00,&H05,_

&H00,&H00,&H00,&H00,&H00,&H00,&H00,&H00,&H00,&H00,_

&H00,&H0B,&H00,&H00,&H00,&H01,&H00,&H00,&H00,&H00,_

&H00,&H00,&H00,&H00,&H00)

' Central Standard Time.

arrDST04 = Array(&H68,&H01,&H00,&H00,&H00,&H00,&H00,&H00,_

&HC4,&HFF,&HFF,&HFF,&H00,&H00,&H0B,&H00,&H00,_

&H00,&H01,&H00,&H02,&H00,&H00,&H00,&H00,&H00,_

&H00,&H00,&H00,&H00,&H03,&H00,&H00,&H00,&H02,_

&H00,&H02,&H00,&H00,&H00,&H00,&H00,&H00,&H00)

' E. South America Standard Time.

arrDST05 = Array(&HB4,&H00,&H00,&H00,&H00,&H00,&H00,&H00,_

&HC4,&HFF,&HFF,&HFF,&H00,&H00,&H02,&H00,&H00,_

&H00,&H05,&H00,&H00,&H00,&H00,&H00,&H00,&H00,_

&H00,&H00,&H00,&H00,&H0B,&H00,&H00,&H00,&H01,_

&H00,&H00,&H00,&H00,&H00,&H00,&H00,&H00,&H00)

' Eastern Standard Time.

arrDST06 = Array(&H2C,&H01,&H00,&H00,&H00,&H00,&H00,&H00,_

&HC4,&HFF,&HFF,&HFF,&H00,&H00,&H0B,&H00,&H00,_

&H00,&H01,&H00,&H02,&H00,&H00,&H00,&H00,&H00,_

&H00,&H00,&H00,&H00,&H03,&H00,&H00,&H00,&H02,_

&H00,&H02,&H00,&H00,&H00,&H00,&H00,&H00,&H00)

' Iran Standard Time.

arrDST07 = Array(&H2E,&HFF,&HFF,&HFF,&H00,&H00,&H00,&H00,_

&HC4,&HFF,&HFF,&HFF,&H00,&H00,&H00,&H00,&H00,_

&H00,&H00,&H00,&H00,&H00,&H00,&H00,&H00,&H00,_

&H00,&H00,&H00,&H00,&H00,&H00,&H00,&H00,&H00,_

&H00,&H00,&H00,&H00,&H00,&H00,&H00,&H00,&H00)

' Israel Standard Time.

arrDST08 = Array(&H88,&HFF,&HFF,&HFF,&H00,&H00,&H00,&H00,_

&HC4,&HFF,&HFF,&HFF,&H00,&H00,&H09,&H00,&H00,_

&H00,&H03,&H00,&H02,&H00,&H00,&H00,&H00,&H00,_

&H00,&H00,&H00,&H00,&H03,&H00,&H05,&H00,&H05,_

&H00,&H02,&H00,&H00,&H00,&H00,&H00,&H00,&H00)

' Mountain Standard Time.

arrDST09 = Array(&HA4,&H01,&H00,&H00,&H00,&H00,&H00,&H00,_

&HC4,&HFF,&HFF,&HFF,&H00,&H00,&H0B,&H00,&H00,_

&H00,&H01,&H00,&H02,&H00,&H00,&H00,&H00,&H00,_

&H00,&H00,&H00,&H00,&H03,&H00,&H00,&H00,&H02,_

&H00,&H02,&H00,&H00,&H00,&H00,&H00,&H00,&H00)

' Newfoundland Standard Time.

arrDST10 = Array(&HD2,&H00,&H00,&H00,&H00,&H00,&H00,&H00,_

&HC4,&HFF,&HFF,&HFF,&H00,&H00,&H0B,&H00,&H00,_

&H00,&H01,&H00,&H00,&H00,&H01,&H00,&H00,&H00,_

&H00,&H00,&H00,&H00,&H03,&H00,&H00,&H00,&H02,_

&H00,&H00,&H00,&H01,&H00,&H00,&H00,&H00,&H00)

' Pacific Standard Time.

arrDST11 = Array(&HE0,&H01,&H00,&H00,&H00,&H00,&H00,&H00,&HC4,_

&HFF,&HFF,&HFF,&H00,&H00,&H0B,&H00,&H00,&H00,&H01,_

&H00,&H02,&H00,&H00,&H00,&H00,&H00,&H00,&H00,&H00,_

&H00,&H03,&H00,&H00,&H00,&H02,&H00,&H02,&H00,&H00,_

&H00,&H00,&H00,&H00,&H00)

' W. Australia Standard Time.

arrDST12 = Array(&H20,&HFE,&HFF,&HFF,&H00,&H00,&H00,&H00,&HC4,_

&HFF,&HFF,&HFF,&H00,&H00,&H03,&H00,&H00,&H00,&H05,_

&H00,&H03,&H00,&H00,&H00,&H00,&H00,&H00,&H00,&H00,_

&H00,&H0A,&H00,&H00,&H00,&H05,&H00,&H02,&H00,&H00,_

&H00,&H00,&H00,&H00,&H00)

' Set standard binary for the start and end DST.

arrDSTSSValue = Array(&H00,&H00,&H0B,&H00,&H01,&H00,&H02,&H00,_

&H00,&H00,&H00,&H00,&H00,&H00,&H00,&H00)

arrDSTDSValue = Array(&H00,&H00,&H03,&H00,&H02,&H00,&H02,&H00,_

&H00,&H00,&H00,&H00,&H00,&H00,&H00,&H00)

' Check the current DST settings to see if they have already been updated.

strDSTTZComp01 = compareDSTDate(strComputer, strKeyPath01, strValueName1, arrDST01)

strDSTTZComp02 = compareDSTDate(strComputer, strKeyPath02, strValueName1, arrDST02)

strDSTTZComp03 = compareDSTDate(strComputer, strKeyPath03, strValueName1, arrDST03)

strDSTTZComp04 = compareDSTDate(strComputer, strKeyPath04, strValueName1, arrDST04)

strDSTTZComp05 = compareDSTDate(strComputer, strKeyPath05, strValueName1, arrDST05)

strDSTTZComp06 = compareDSTDate(strComputer, strKeyPath06, strValueName1, arrDST06)

strDSTTZComp07 = compareDSTDate(strComputer, strKeyPath07, strValueName1, arrDST07)

strDSTTZComp08 = compareDSTDate(strComputer, strKeyPath08, strValueName1, arrDST08)

strDSTTZComp09 = compareDSTDate(strComputer, strKeyPath09, strValueName1, arrDST09)

strDSTTZComp10 = compareDSTDate(strComputer, strKeyPath10, strValueName1, arrDST10)

strDSTTZComp11 = compareDSTDate(strComputer, strKeyPath11, strValueName1, arrDST11)

strDSTTZComp12 = compareDSTDate(strComputer, strKeyPath12, strValueName1, arrDST12)

' Check the current start and end DST settings to see if they have been updated.

strDSTSSComp = compareDSTDate(strComputer, strKeyPath13, strValueName2, arrDSTSSValue)

strDSTDSComp = compareDSTDate(strComputer, strKeyPath14, strValueName3, arrDSTDSValue)

' Add all the compared values and get the total number.

strCompValue = strDSTTZComp01+strDSTTZComp02+strDSTTZComp03+strDSTTZComp04+strDSTTZComp05+ _

strDSTTZComp06+strDSTTZComp07+strDSTTZComp08+strDSTTZComp09+strDSTTZComp10+strDSTTZComp11+ _

strDSTTZComp12+strDSTSSComp+strDSTDSComp

' If the current DST dates have been updated, the compared value will be 14 and skip

' the update routines below.

If strCompValue = 14 Then

setDSTValue = "Already updated"

Exit Function

Else

' Set DST dates for the twelve time zones.

strSetDST01 = setDSTDate(strComputer, strKeyPath01, strValueName1, arrDST01)

strSetDST02 = setDSTDate(strComputer, strKeyPath02, strValueName1, arrDST02)

strSetDST03 = setDSTDate(strComputer, strKeyPath03, strValueName1, arrDST03)

strSetDST04 = setDSTDate(strComputer, strKeyPath04, strValueName1, arrDST04)

strSetDST05 = setDSTDate(strComputer, strKeyPath05, strValueName1, arrDST05)

strSetDST06 = setDSTDate(strComputer, strKeyPath06, strValueName1, arrDST06)

strSetDST07 = setDSTDate(strComputer, strKeyPath07, strValueName1, arrDST07)

strSetDST08 = setDSTDate(strComputer, strKeyPath08, strValueName1, arrDST08)

strSetDST09 = setDSTDate(strComputer, strKeyPath09, strValueName1, arrDST09)

strSetDST10 = setDSTDate(strComputer, strKeyPath10, strValueName1, arrDST10)

strSetDST11 = setDSTDate(strComputer, strKeyPath11, strValueName1, arrDST11)

strSetDST12 = setDSTDate(strComputer, strKeyPath12, strValueName1, arrDST12)

' Set standard DST start date.

strSetDST13 = setDSTDate(strComputer, strKeyPath13, strValueName2, arrDSTSSValue)

' Set DST day light start date.

strSetDST14 = setDSTDate(strComputer, strKeyPath14, strValueName3, arrDSTDSValue)

' Add all the update values and get the total number.

strUpdateCheck = strSetDST01+strSetDST02+strSetDST03+strSetDST04+strSetDST05+ _

strSetDST06+strSetDST07+strSetDST08+strSetDST09+strSetDST10+strSetDST11+strSetDST12+ _

strSetDST13+strSetDST14

' If the update is successful, the value will be 14. Otherwise, the value is other number.

If strUpdateCheck = 14 Then

setDSTValue = "Success"

Else

setDSTValue = "Failed"

End If

End If

End Function

' Function to compare the registry data with the new DST Dates.

Private Function compareDSTDate(strComputer, strKeyPath, strValueName, arrBinValue)

Const HKEY_LOCAL_MACHINE = &H80000002

Dim objRegistry, arrCurrentValue, objItem, strBinValue1, strBinValue2

Set objRegistry = GetObject("winmgmts:{impersonationLevel=impersonate}//" & _

strComputer & "/root/default:StdRegProv")

objRegistry.GetBinaryValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,arrCurrentValue

If Not IsNull(arrCurrentValue) Then

For Each objItem In arrCurrentValue

strBinValue1 = strBinValue1 & objItem

Next

For Each objItem In arrBinValue

strBinValue2 = strBinValue2 & objItem

Next

If strBinValue1 = strBinValue2 Then

compareDSTDate = 1

Exit Function

End If

Else

compareDSTDate = 0

End If

Set objRegistry = Nothing

End Function

' Function to update the registry data for the new DST Dates.

Private Function setDSTDate(strComputer, strKeyPath, strValueName, arrBinValue)

Const HKEY_LOCAL_MACHINE = &H80000002

Dim objRegistry, arrCurrentValue, strCKeyPath, arrValue, objItem, strBinValue1

Dim strBinValue2

Set objRegistry = GetObject("winmgmts:{impersonationLevel=impersonate}//" & _

strComputer & "/root/default:StdRegProv")

On Error Resume Next

objRegistry.GetBinaryValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,arrCurrentValue

If Not IsNull(arrCurrentValue) Then

objRegistry.SetBinaryValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,arrBinValue

If Err Then

setDSTDate = 0

Else

setDSTDate = 1

End If

Else

' Set the Central Brazilian Standard Time DST data if it deos not exist.

strCKeyPath = Mid(strKeyPath,InStrRev(strKeyPath,"\")+1)

If strCKeyPath = "Central Brazilian Standard Time" Then

objRegistry.EnumKey HKEY_LOCAL_MACHINE,strKeyPath,arrValue

If IsNull(arrValue) Then

objRegistry.CreateKey HKEY_LOCAL_MACHINE,strKeyPath

objRegistry.SetStringValue HKEY_LOCAL_MACHINE,strKeyPath,"Display","(GMT-04:00) Manaus"

objRegistry.SetStringValue HKEY_LOCAL_MACHINE,strKeyPath,"Dlt","Central Brazilian Daylight Time"

objRegistry.SetDWORDValue HKEY_LOCAL_MACHINE,strKeyPath,"Index","2147483720"

objRegistry.SetStringValue HKEY_LOCAL_MACHINE,strKeyPath,"Std","Central Brazilian Standard Time"

objRegistry.SetBinaryValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,arrBinValue

End If

End If

objRegistry.GetBinaryValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,arrCurrentValue

For Each objItem In arrCurrentValue

strBinValue1 = strBinValue1 & objItem

Next

For Each objItem In arrBinValue

strBinValue2 = strBinValue2 & objItem

Next

If strBinValue1 = strBinValue2 Then

setDSTDate = 1

Else

setDSTDate = 0

End If

End If

Err.Clear

On Error Goto 0

Set objRegistry = Nothing

End Function

' Sub routine to print the screen message.

Private Sub PrintMsg(strMessage)

If InStr(strMessage, "successfully") > 0 Then

CreateObject("WScript.Shell").Popup strMessage,60,strScriptName,vbInformation

ElseIf InStr(strMessage, "already") > 0 Then

CreateObject("WScript.Shell").Popup strMessage,60,strScriptName,vbInformation

Else

CreateObject("WScript.Shell").Popup strMessage,60,strScriptName,vbCritical

End If

End Sub

----------------------

Link to comment
Share on other sites
  • Moderators
SmOke_N Universalist

SmOke_N

Posted
  • Moderators
Posted

There's been some discussion here on that subject lately, have you looked at these?

http://www.autoitscript.com/forum/index.ph...highlite=%2BDST

Common sense plays a role in the basics of understanding AutoIt... If you're lacking in that, do us all a favor, and step away from the computer.

Link to comment
Share on other sites
  • 5 months later...
StooJ Seeker

StooJ

Posted
Posted

This has been invaluable! I'm so pleased I can bundle my vbscript into AutoIt completely instead of having an extra vbs file kicking about.

The script needed a little tweaking before it would work properly, just declaring variables and so forth, but your converter did all the heavy lifting for me.

Many thanks

Link to comment
Share on other sites
  • 2 weeks later...
  • 5 months later...
GEOSoft Universalist

GEOSoft

Posted
Posted

Thanks for this program! Is there a new version of it? It has take me lots of work out of my hands!

This project has been dead for a long time (shame) I use a version of it that I modified somewhat. For example The Do Until issue. Those are easy to do. I started to write a whole new Vsv - Au3 converter but it ended up on the back burner. On good method of using it is to compile the script and create a shortcut to it in your Send To Menu then just R-Click a vbs file and Send To >>>>>

George

Question about decompiling code? Read the decompiling FAQ and don't bother posting the question in the forums.

Be sure to read and follow the forum rules. -AKA the AutoIt Reading and Comprehension Skills test.***

The PCRE (Regular Expression) ToolKit for AutoIT - (Updated Oct 20, 2011 ver:3.0.1.13) - Please update your current version before filing any bug reports. The installer now includes both 32 and 64 bit versions. No change in version number.

Visit my Blog .. currently not active but it will soon be resplendent with news and views. Also please remove any links you may have to my website. it is soon to be closed and replaced with something else.

"Old age and treachery will always overcome youth and skill!"

Link to comment
Share on other sites
  • 3 months later...
  • 3 weeks later...
daluu Adventurer

daluu

Posted
Posted

Would be nice to have a reverse converter - AutoIt script to VBScript. Does one currently exist?

As with the current converter this thread refers to, you can never get a 100% conversion depending on the things you do in VBScript as you can mix VB with WMI, WSH, ASP, and other ActiveX/COM objects.

But for the basic stuff, it sure would be nice to have it the other way around as well. I'm accustomed to using VBScript and it offers more capabilities (albeit sometimes more code compared to using AutoIt). There are some things AutoIt can't do that VBScript can and I'd prefer not to have to learn another language if I don't have to.

Link to comment
Share on other sites
weaponx Universalist

weaponx

Posted
Posted

Would be nice to have a reverse converter - AutoIt script to VBScript. Does one currently exist?

As with the current converter this thread refers to, you can never get a 100% conversion depending on the things you do in VBScript as you can mix VB with WMI, WSH, ASP, and other ActiveX/COM objects.

But for the basic stuff, it sure would be nice to have it the other way around as well. I'm accustomed to using VBScript and it offers more capabilities (albeit sometimes more code compared to using AutoIt). There are some things AutoIt can't do that VBScript can and I'd prefer not to have to learn another language if I don't have to.

I don't want to start anything in this topic but if you could create a new topic in Chat it would be better than hijcaking this thread.

Link to comment
Share on other sites
  • 1 month later...
iceberg Universalist

iceberg

Posted
Posted

oh ok.

but i tried uninstalling and installing an old version....ver 3.1.1

it still fails....tats what puzzles me.

any other thghts?

anyone has a working copy? maybe can send me the compiled exe version....?

mouse not found....scroll any mouse to continue.

Link to comment
Share on other sites
  • 1 month later...
  • 2 months later...
ken82m Universalist

ken82m

Posted
Posted

I don't know VB :mellow: but I used your script to convert the script below.

I also posted the output.

Now I can see the variable names are missing the "$" and I tried adding

fixing that and then removing the $'s from the "$As $Long".

But "long" doesn't seem to be recognized and I get a syntax error on the "As"

Can anyone offer any help?

The application is supposed to bring up a window to browse for a user account.

The site said it was written in VB6

Thanks,

Kenny

Input:

Private Const NERR_SUCCESS                          As Long = 0&
Private Const OPENUSERBROWSER_INCLUDE_SYSTEM          As Long = &H10000
Private Const OPENUSERBROWSER_SINGLE_SELECTION      As Long = &H1000&
Private Const OPENUSERBROWSER_NO_LOCAL_DOMAIN        As Long = &H100&
Private Const OPENUSERBROWSER_INCLUDE_CREATOR_OWNER   As Long = &H80&
Private Const OPENUSERBROWSER_INCLUDE_EVERYONE      As Long = &H40&
Private Const OPENUSERBROWSER_INCLUDE_INTERACTIVE    As Long = &H20&
Private Const OPENUSERBROWSER_INCLUDE_NETWORK        As Long = &H10&
Private Const OPENUSERBROWSER_INCLUDE_USERS        As Long = &H8&
Private Const OPENUSERBROWSER_INCLUDE_USER_BUTTONS  As Long = &H4&
Private Const OPENUSERBROWSER_INCLUDE_GROUPS          As Long = &H2&
Private Const OPENUSERBROWSER_INCLUDE_ALIASES        As Long = &H1&
Private Const OPENUSERBROWSER_FLAGS                As Long = OPENUSERBROWSER_INCLUDE_USERS Or _
                                                                OPENUSERBROWSER_INCLUDE_USER_BUTTONS Or _
                                                                OPENUSERBROWSER_INCLUDE_EVERYONE Or _
                                                                OPENUSERBROWSER_INCLUDE_INTERACTIVE Or _
                                                                OPENUSERBROWSER_INCLUDE_NETWORK Or _
                                                                OPENUSERBROWSER_INCLUDE_ALIASES
Private Type OPENUSERBROWSER_STRUCT
   cbSize       As Long
   fCancelled   As Long
   Unknown     As Long
   hWndParent   As Long
   szTitle     As Long
   szDomainName  As Long
   dwFlags     As Long
   dwHelpID   As Long
   szHelpFile   As Long
End Type

Private Type ENUMUSERBROWSER_STRUCT
   SidType      As Long
   Sid1        As Long
   Sid2        As Long
   szFullName    As Long
   szUserName    As Long
   szDisplayName  As Long
   szDomainName   As Long
   szDescription  As Long
   sBuffer      As String * 1000
End Type

Private Declare Function OpenUserBrowser Lib "netui2.dll" _
  (lpOpenUserBrowser As Any) As Long
   
Private Declare Function EnumUserBrowserSelection Lib "netui2.dll" _
  (ByVal hBrowser As Long, _
   ByRef lpEnumUserBrowser As Any, _
   ByRef cbSize As Long) As Long
   
Private Declare Function CloseUserBrowser Lib "netui2.dll" _
   (ByVal hBrowser As Long) As Long
   
Private Declare Function lstrlenW Lib "kernel32" _
   (ByVal lpString As Long) As Long
   
Private Declare Sub CopyMemory Lib "kernel32" _
   Alias "RtlMoveMemory" _
  (Destination As Any, _
   Source As Any, _
   ByVal Length As Long)


Private Sub Form_Load()

   Dim cnt As Long

  'load and show 11 Check1 controls
   For cnt = 0 To 10
      
      If cnt <> 0 Then Load Check1(cnt)
      
      With Check1(cnt)
      
         If cnt < 6 Then
            .Move 360, 360 + (Check1(cnt).Height * cnt), 2500
         Else
            .Move 2860, 360 + (Check1(cnt).Height * (cnt - 6)), 2500
         End If
         
         Select Case cnt
            Case 0:  .Caption = "include aliases"
            Case 1:  .Caption = "include groups"
            Case 2:  .Caption = "include user buttons"
            Case 3:  .Caption = "include users"
            Case 4:  .Caption = "include network"
            Case 5:  .Caption = "include 'interactive'"
            Case 6:  .Caption = "include 'everyone'"
            Case 7:  .Caption = "include 'creator owner'"
            Case 8:  .Caption = "include 'system'"
            Case 9:  .Caption = "single selection"
            Case 10: .Caption = "no local domain"
            Case Else
         End Select
      
         .Visible = True
      
      End With
      
   Next

   With Command1
      .Caption = "OpenUserBrowser"
      .Move Check1(5).Left, _
           (Check1(5).Height * 5) + 780
   End With
   
   With Text1
      .Move Command1.Left, _
            Command1.Top + Command1.Height + 300, _
            Me.ScaleWidth - 720
                  
      Me.Height = .Top + .Height + 780
      
   End With 
   
End Sub


Private Sub Command1_Click()

   Dim sUsers As String

   If GetBrowserNames(Me.hWnd, _
                      "\\vbnetdev", _
                      "VBnet Add Users & Groups Demo", _
                      sUsers) Then
      Text1.Text = sUsers
   End If

End Sub


Private Function BuildFlags() As Long

  'using a var to shorten web display ...
  'in application can replace var with
  'the function name itself
   Dim bf As Long

  'clear and set flags
   bf = 0&
   
   If Check1(0).Value = 1 Then bf = bf Or OPENUSERBROWSER_INCLUDE_ALIASES
   If Check1(1).Value = 1 Then bf = bf Or OPENUSERBROWSER_INCLUDE_GROUPS
   If Check1(2).Value = 1 Then bf = bf Or OPENUSERBROWSER_INCLUDE_USER_BUTTONS
   If Check1(3).Value = 1 Then bf = bf Or OPENUSERBROWSER_INCLUDE_USERS
   If Check1(4).Value = 1 Then bf = bf Or OPENUSERBROWSER_INCLUDE_NETWORK
   If Check1(5).Value = 1 Then bf = bf Or OPENUSERBROWSER_INCLUDE_INTERACTIVE
   If Check1(6).Value = 1 Then bf = bf Or OPENUSERBROWSER_INCLUDE_EVERYONE
   If Check1(7).Value = 1 Then bf = bf Or OPENUSERBROWSER_INCLUDE_CREATOR_OWNER
   If Check1(8).Value = 1 Then bf = bf Or OPENUSERBROWSER_INCLUDE_SYSTEM
   If Check1(9).Value = 1 Then bf = bf Or OPENUSERBROWSER_SINGLE_SELECTION
   If Check1(10).Value = 1 Then bf = bf Or OPENUSERBROWSER_NO_LOCAL_DOMAIN
   
   BuildFlags = bf

End Function


Private Function GetBrowserNames(ByVal hParent As Long, _
                                 ByVal sDomain As String, _
                                 ByVal sTitle As String, _
                                 sBuff As String) As Boolean

   Dim hBrowser   As Long
   Dim browser  As OPENUSERBROWSER_STRUCT
   Dim enumb      As ENUMUSERBROWSER_STRUCT
   
  'initialize the OPENUSERBROWSER structure
   With browser
      .cbSize = Len(browser)
      .fCancelled = 0
      .Unknown = 0
      .hWndParent = hParent
      .szTitle = StrPtr(sTitle)
      .szDomainName = StrPtr(sDomain)
      .dwFlags = BuildFlags()
   End With
   
  'show the dialog function
   hBrowser = OpenUserBrowser(browser)
   
  'if not cancelled...
   If browser.fCancelled = NERR_SUCCESS Then
   
      '...retrieve any selections and populate
      'the sBuff string passed to this function,
      'returning True if successful.
       Do While EnumUserBrowserSelection(hBrowser, enumb, Len(enumb) + 1) <> 0
       
          'return selection as \\DOMAIN\NAME
          'can be adjusted at will
           sBuff = sBuff & GetPointerToByteStringW(enumb.szDomainName) & "\" & _
                           GetPointerToByteStringW(enumb.szUserName) & vbCrLf
                           
           GetBrowserNames = True
           
       Loop
       
       Call CloseUserBrowser(hBrowser)
       
      'if desired, strip the last crlf from the string
       If GetBrowserNames = True Then
           sBuff = Left(sBuff, Len(sBuff) - 2)
       End If
   End If
    
End Function


Private Function GetPointerToByteStringW(ByVal dwData As Long) As String
  
   Dim tmp() As Byte
   Dim tmplen As Long
   
   If dwData <> 0 Then
   
      tmplen = lstrlenW(dwData) * 2
      
      If tmplen <> 0 Then
      
         ReDim tmp(0 To (tmplen - 1)) As Byte
         CopyMemory tmp(0), ByVal dwData, tmplen
         GetPointerToByteStringW = tmp
         
     End If
     
   End If
    
End Function

Output:

#include <date.au3>

Dim Const NERR_SUCCESS                          $As $Long = 0&
Dim Const OPENUSERBROWSER_INCLUDE_SYSTEM          $As $Long = &H10000
Dim Const OPENUSERBROWSER_SINGLE_SELECTION      $As $Long = &H1000&
Dim Const OPENUSERBROWSER_NO_LOCAL_DOMAIN        $As $Long = &H100&
Dim Const OPENUSERBROWSER_INCLUDE_CREATOR_OWNER   $As $Long = &H80&
Dim Const OPENUSERBROWSER_INCLUDE_EVERYONE      $As $Long = &H40&
Dim Const OPENUSERBROWSER_INCLUDE_INTERACTIVE    $As $Long = &H20&
Dim Const OPENUSERBROWSER_INCLUDE_NETWORK        $As $Long = &H10&
Dim Const OPENUSERBROWSER_INCLUDE_USERS        $As $Long = &H8&
Dim Const OPENUSERBROWSER_INCLUDE_USER_BUTTONS  $As $Long = &H4&
Dim Const OPENUSERBROWSER_INCLUDE_GROUPS          $As $Long = &H2&
Dim Const OPENUSERBROWSER_INCLUDE_ALIASES        $As $Long = &H1&
Dim Const OPENUSERBROWSER_FLAGS                $As $Long = OPENUSERBROWSER_INCLUDE_USERS Or _
                                                                OPENUSERBROWSER_INCLUDE_USER_BUTTONS Or _
                                                                OPENUSERBROWSER_INCLUDE_EVERYONE Or _
                                                                OPENUSERBROWSER_INCLUDE_INTERACTIVE Or _
                                                                OPENUSERBROWSER_INCLUDE_NETWORK Or _
                                                                OPENUSERBROWSER_INCLUDE_ALIASES
Dim $Type OPENUSERBROWSER_STRUCT
   $cbSize      $As $Long
   $fCancelled  $As $Long
   $Unknown    $As $Long
   $hWndParent  $As $Long
   $szTitle    $As $Long
   $szDomainName  $As $Long
   $dwFlags    $As $Long
   $dwHelpID      $As $Long
   $szHelpFile  $As $Long
End $Type

Dim $Type ENUMUSERBROWSER_STRUCT
   $SidType     $As $Long
   $Sid1           $As $Long
   $Sid2           $As $Long
   $szFullName   $As $Long
   $szUserName   $As $Long
   $szDisplayName  $As $Long
   $szDomainName   $As $Long
   $szDescription  $As $Long
   $sBuffer     $As String $* 1000
End $Type

Dim $Declare Func $OPENUSERBROWSER $Lib "netui2.dll" _[]
  ($lpOpenUserBrowser $As $Any) $As $Long
   
Dim $Declare Func $EnumUserBrowserSelection $Lib "netui2.dll" _[]
  ( $hBrowser $As $Long, _
   $ByRef $lpEnumUserBrowser $As $Any, _
   $ByRef $cbSize $As $Long) $As $Long
   
Dim $Declare Func $CloseUserBrowser $Lib "netui2.dll" _[]
   ( $hBrowser $As $Long) $As $Long
   
Dim $Declare Func $lstrlenW $Lib "kernel32" _[]
   ( $lpString $As $Long) $As $Long
   
Dim $Declare Func $CopyMemory $Lib "kernel32" _[]
   $Alias "RtlMoveMemory" _
  ($Destination $As $Any, _
   $Source $As $Any, _
    $Length $As $Long)


Func Form_Load()

   Dim $cnt $As $Long

 ;load and show 11 $Check1 controls
   For $cnt = 0 To 10
      
      If $cnt <> 0 Then $Load $Check1($cnt)
      
      With $Check1($cnt)
      
         If $cnt < 6 Then
            .Move (360, 360 + ($Check1($cnt).Height $* $cnt), 2500)
         Else
            .Move (2860, 360 + ($Check1($cnt).Height $* ($cnt - 6)), 2500)
         EndIf
         
         Select 
            Case $cnt=$0:  .Caption = "include aliases"
            Case $cnt=$1:  .Caption = "include groups"
            Case $cnt=$2:  .Caption = "include $USER buttons"
            Case $cnt=$3:  .Caption = "include users"
            Case $cnt=$4:  .Caption = "include network"
            Case $cnt=$5:  .Caption = "include 'interactive'"
            Case $cnt=$6:  .Caption = "include 'everyone'"
            Case $cnt=$7:  .Caption = "include 'creator owner'"
            Case $cnt=$8:  .Caption = "include 'system'"
            Case $cnt=$9:  .Caption = "single selection"
            Case $cnt=$10: .Caption = "no $LOCAL domain"
            Case Else
         EndSelect
      
         .Visible = 1
      
      End With
      
   Next

   With $Command1
      .Caption = "OpenUserBrowser"
      .Move ($Check1(5).StringLeft, _)
           ($Check1(5).Height $* 5) + 780
   End With
   
   With $Text1
      .Move ($Command1.StringLeft, _)
            $Command1.Top (+ $Command1.Height + 300, _)
            $Me.ScaleWidth (- 720)
                  
      $Me.Height = .Top + .Height + 780
      
   End With 
   
EndFunc


Func Command1_Click()

   Dim $sUsers $As String

   If GetBrowserNames($Me.hWnd, _
                      "\\vbnetdev", _
                      "VBnet Add $USERS & $GROUPS Demo", _
                      $sUsers) Then
      $Text1.Text = $sUsers
   EndIf

EndFunc


Dim Func BuildFlags[] $As $Long
    Local $Return

 ;using a var to shorten web display ...
 ;in application can replace var with
 ;the function name itself
   Dim $bf $As $Long

 ;clear and set $FLAGS
   $bf = 0&
   
   If $Check1(0).Value = 1 Then $bf = $bf Or OPENUSERBROWSER_INCLUDE_ALIASES
   If $Check1(1).Value = 1 Then $bf = $bf Or OPENUSERBROWSER_INCLUDE_GROUPS
   If $Check1(2).Value = 1 Then $bf = $bf Or OPENUSERBROWSER_INCLUDE_USER_BUTTONS
   If $Check1(3).Value = 1 Then $bf = $bf Or OPENUSERBROWSER_INCLUDE_USERS
   If $Check1(4).Value = 1 Then $bf = $bf Or OPENUSERBROWSER_INCLUDE_NETWORK
   If $Check1(5).Value = 1 Then $bf = $bf Or OPENUSERBROWSER_INCLUDE_INTERACTIVE
   If $Check1(6).Value = 1 Then $bf = $bf Or OPENUSERBROWSER_INCLUDE_EVERYONE
   If $Check1(7).Value = 1 Then $bf = $bf Or OPENUSERBROWSER_INCLUDE_CREATOR_OWNER
   If $Check1(8).Value = 1 Then $bf = $bf Or OPENUSERBROWSER_INCLUDE_SYSTEM
   If $Check1(9).Value = 1 Then $bf = $bf Or OPENUSERBROWSER_SINGLE_SELECTION
   If $Check1(10).Value = 1 Then $bf = $bf Or OPENUSERBROWSER_NO_LOCAL_DOMAIN
   
   $Return = $bf

    Return $Return
EndFunc


Dim Func GetBrowserNames[ $hParent $As $Long, _]
    Local $Return
                                  $sDomain $As String, _
                                  $sTitle $As String, _
                                 $sBuff $As String) $As $Boolean

   Dim $hBrowser   $As $Long
   Dim $browser $As OPENUSERBROWSER_STRUCT
   Dim $enumb     $As ENUMUSERBROWSER_STRUCT
   
 ;initialize the $OPENUSERBROWSER structure
   With $browser
      .$cbSize = StringLen($browser)
      .$fCancelled = 0
      .$Unknown = 0
      .$hWndParent = $hParent
      .$szTitle = $StrPtr($sTitle)
      .$szDomainName = $StrPtr($sDomain)
      .$dwFlags = BuildFlags()
   End With
   
 ;show the dialog function
   $hBrowser = $OPENUSERBROWSER($browser)
   
 ;if not cancelled...
   If $browser.$fCancelled = NERR_SUCCESS Then
   
     ;...retrieve $Any selections and populate
     ;the $sBuff string passed to this function,
     ;returning True if successful.
       Do While $EnumUserBrowserSelection($hBrowser, $enumb, StringLen($enumb) + 1) <> 0
       
         ;return $SELECTION $As \\DOMAIN\NAME
         ;can be adjusted at will
           $sBuff = $sBuff & GetPointerToByteStringW($enumb.$szDomainName) & "\" & _
                           GetPointerToByteStringW($enumb.$szUserName) (& @CRLF)
                           
           $Return = 1
           
       Loop
       
        $CloseUserBrowser($hBrowser)
       
     ;if desired, strip the last crlf from the string
       If $Return = 1 Then
           $sBuff = StringLeft($sBuff, StringLen($sBuff) - 2)
       EndIf
   EndIf
    
    Return $Return
EndFunc


Dim Func GetPointerToByteStringW[ $dwData $As $Long] $As String
    Local $Return
  
   Dim $tmp[] $As $Byte
   Dim $tmplen $As $Long
   
   If $dwData <> 0 Then
   
      $tmplen = $lstrlenW($dwData) $* 2
      
      If $tmplen <> 0 Then
      
         ReDim $tmp[0 To ($tmplen - 1)] $As $Byte
         $CopyMemory $tmp(0),  $dwData, $tmplen
         $Return = $tmp
         
     EndIf
     
   EndIf
    
    Return $Return
EndFunc

 "I believe that when we leave a place, part of it goes with us and part of us remains... Go anywhere, when it is quiet, and just listen.. After a while, you will hear the echoes of all our conversations, every thought and word we've exchanged.... Long after we are gone our voices will linger in these walls for as long as this place remains."

Link to comment
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
 Share
Go to topic listing

  • Recently Browsing   0 members

    • No registered users viewing this page.
×
×
  • Create New...