Quote:

---

Les, my dr. evil avatar is far from my actual appearance...

---

LOL... Mine doesn't do me justice either.

Anyway, I commend you on your bravery in taking on such a monumental task.

Quote:

---

Microsoft has a daily article on "Howto" in VBS, called Hey, Scripting Guy! and the archives may help you in your quest.

---

Quote:

---

I'm probably not alone here by saying VBScript's error handling has me frustrated. Particularly, COM errors that vbscript doesn't seem to be able to interpret.

For instance, if I run this code snippet:

On Error Resume Next
Set objGroup = GetObject("WinNT://"& strComputer &"/"& strLocalDestinationGroup)
objGroup.Add "WinNT://"& strUserToAdd
wscript.echo err.number
wscript.echo err.description

and it fails because the user I'm trying to add already belongs to the target group, the err returned is:
-2147023518
and the descriiption is empty. Therein lies the problem.

HOWEVER, if I remove the On Error Resume Next, the compiler quits execution on the .Add method and correctly resolves the error to:

User is already a member of the target group.

So I'm using this function to convert the error to hex and back again into a standard System Error Code.

Function CError(lErr)
If lErr<0 Then lErr=HexToDec(Right(Hex(lErr),4)) End If
Err.Number = lErr
End function

Function HexToDec(strHex)
dim lngResult
dim intIndex
dim strDigit
dim intDigit
dim intValue

lngResult = 0
for intIndex = len(strHex) to 1 step -1
strDigit = mid(strHex, intIndex, 1)
intDigit = instr("0123456789ABCDEF", ucase(strDigit))-1
if intDigit >= 0 then
intValue = intDigit * (16 ^ (len(strHex)-intIndex))
lngResult = lngResult + intValue
else
lngResult = 0
intIndex = 0 ' stop the loop
end if
next

HexToDec = lngResult
End Function

Now, CError will properly convert -2147023518 to decimal 1378 which we can verify on this table: http://msdn.microsoft.com/library/default.asp?url=/library/en-us/debug/base/system_error_codes__1300-1699_.asp

The problem is this. If I try to err.raise= 1378, VBScript is clueless. Setting err.number = 1378 does help either.

How can I get VBScript to recognize and resolve these standard error codes to the proper description?

Any other error handling methodologies would be great help as well.

---

  

on error resume next

strComputer="computer"

strLocalDestinationGroup="Administrators"

strUsertoAdd="Administrator"



Set objGroup = GetObject("WinNT://"& strComputer &"/"& strLocalDestinationGroup)

objGroup.Add "WinNT://"& strUserToAdd

cerror(err.number)

wscript.echo err.number

wscript.echo err.description



Function CError(lErr)

  dim cerr,ws,temp,cerrorfile,ret,fs,file,output

  If lErr<0 Then

    cErr=HexToDec(Right(Hex(lErr),4))

    Set ws=Wscript.createobject("Wscript.Shell")

    temp=ws.expandenvironmentStrings("%temp%")

    cerrorfile=temp & "\cerror.txt"

    ret=ws.run ("%comspec% /c net helpmsg " & cerr & " >" & CerrorFile,0,"True")

    set fs=wscript.createobject("Scripting.FilesystemObject")

    Set File=fs.OpenTextFile(cerrorfile,1)

    file.skipline

    output=file.readline

    file.close

    err.raise cerr,,output    

  End If

End function



Function HexToDec(strHex)

dim lngResult

dim intIndex

dim strDigit

dim intDigit

dim intValue



lngResult = 0

for intIndex = len(strHex) to 1 step -1

strDigit = mid(strHex, intIndex, 1)

intDigit = instr("0123456789ABCDEF", ucase(strDigit))-1

if intDigit >= 0 then

intValue = intDigit * (16 ^ (len(strHex)-intIndex))

lngResult = lngResult + intValue

else

lngResult = 0

intIndex = 0 ' stop the loop

end if

next



HexToDec = lngResult

End Function

 

on error resume next



strComputer="computer"

strLocalDestinationGroup="Administrators"

strUsertoAdd="Administrator"



Set objGroup = GetObject("WinNT://"& strComputer &"/"& strLocalDestinationGroup)

objGroup.Add "WinNT://"& strUserToAdd

cerror(err.number)

wscript.echo err.number

wscript.echo err.description



function display

  Msgbox Err.number & ":" & Err.Description

  Err.clear

end function



Function CError(lErr)

  dim cerr,output,line,errdesc

  If lErr<0 Then

    cErr=HexToDec(Right(Hex(lErr),4))

    output=wshpipe("net helpmsg " & cerr)

    for each line in output

      if line<>"" then

        errdesc=errdesc & " " & line

      end if

    next

    errdesc=ltrim(errdesc)

    Err.raise cerr,,errdesc

  End If

End function



Function WshPipe(ShellCMD)

  Dim oExec, Output, ExitCode

  Set oExec = CreateObject("WScript.Shell").Exec(ShellCMD)

  If Not VarType(oExec)=9 then

    WshPipe="WScript.Shell Exec Unsupported"

    Err.Raise 10

    Exit Function

  End If

  Output = oExec.StdOut.ReadAll & oExec.StdErr.ReadAll

  WshPipe=Split(Join(Split(Output,CHR(13)),""),CHR(10))

End Function



Function HexToDec(strHex)

dim lngResult

dim intIndex

dim strDigit

dim intDigit

dim intValue



lngResult = 0

for intIndex = len(strHex) to 1 step -1

strDigit = mid(strHex, intIndex, 1)

intDigit = instr("0123456789ABCDEF", ucase(strDigit))-1

if intDigit >= 0 then

intValue = intDigit * (16 ^ (len(strHex)-intIndex))

lngResult = lngResult + intValue

else

lngResult = 0

intIndex = 0 ' stop the loop

end if

next



HexToDec = lngResult

End Function





 

Quote:

---

I guess Jim will have to tell you why nothing is on the project home page, but he does have files here:
http://cvs.sourceforge.net/viewcvs.py/vbscript/#dirlist

---

ret = myfunction(string1, null, string2)
function myfunction(arg1,optarg1,optarg2)
    If IsNull(optarg1) Then
        'do nothing with it
    Else
        'do something with it
    End If

    If IsNull(optarg2) Then
        'do nothing with it
    Else
        'do something with it
    End If
End function