VBscript anomalies - vbscript

Why does the following work in VBScript (classic ASP)
Dim y: y = rs("file_description")
Dim x: x = (instr(y, "Internal Server Error") <> 0 or instr(y, "Server Unavailable") <> 0) AND instr(y, "RetryCount=9") = 0
But this does not work. It halts execution (without an error number or description!)
dim x: x = (instr(rs("file_description"), "Internal Server Error") <> 0 or instr(rs("file_description"), "Server Unavailable") <> 0) AND instr(rs("file_description"), "RetryCount=9") = 0
Seems strange that simply extracting the rs("file_description") expression into a variable causes the code to work.
I don't understand why.

rs("file_description") can mean the field object or its default property .Value. VBScript picks one or another depending on the context. Because
y = rs("file_description")
does not use Set, y will contain the .Value. To make things clear for the second aproach, use
x = (instr(rs("file_description").Value, ...

Related

VB6 Join on LongArray gives Type mismatch error after windows update

As of a windows update, the Join operator in VB6 is throwing a Type mismatch error.
My vb6 jtTaskBO class has the following properties;
Friend Property Set PredecessorOffsets(ByVal Offsets As LongArray)
mPredecessorOffsets.Assign Offsets
End Property
Public Property Get PredecessorOffsets() As LongArray
Set PredecessorOffsets = mPredecessorOffsets
End Property
My code has been working for years but I had to modify it today as follows;
Private Function GetPredecessorsDisplay(bo As jtTaskBO)
On Error GoTo error_handle:
' This used to work
' GetPredecessorsDisplay = Join(bo.PredecessorOffsets, ", ")
' replaced by the following
Dim s As String
s = ""
If Not IsNull(bo.PredecessorOffsets) Then
If (bo.PredecessorOffsets.Count > 0) Then
Dim i As Integer
Dim n As Integer
n = bo.PredecessorOffsets.Count - 1
For i = 0 To n
If i <> 0 Then s = s & ", "
s = s & bo.PredecessorOffsets(i)
Next
End If
End If
GetPredecessorsDisplay = s
exit_point:
Exit Function
error_handle:
MsgBox Error$
Resume exit_point
End Function
Winver reports
Windows 10 version 1809 Build 17763.678
A user also reports the issue with Windows 7
Is there any way to fix the issue without doing a release?
I see there is mention of VB6 in KB4511553 or KB4512508
[Update]
I updated to version 1903 Build 18362.295 but the issue is still there.
Is there an official channel to report to Microsoft via?

why when pass arguments on a sub vb6 i retrieve error?

i wrote this code:
Sub Insert_Pic_From_File2(PicPath As String, ByVal row As Integer, ByVal col As Integer)
Dim Pic As Picture, Sh As Shape, Rng As Range
Set Rng = Range.Cells(row, col)
Set Rng = Rng.MergeArea
With Rng
Set Sh = ActiveSheet.Shapes.AddPicture(Filename:=PicPath, linkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height)
Sh.LockAspectRatio = msoFalse
End With
Set Sh = Nothing
Set Rng = Nothing
End Sub
and I call it from this line:
Insert_Pic_From_File2 ("D:\Area Open\ok.png", y, col_result)
both y and col_result are integer.
When I press enter the program give this error (in italian)
errore di compilazione:
Previsto: =
i think in english:
compilation error:
needed: =
Why this?
if i delete the arguments y and col_result seems no problem, but without arguments.
Thanks so much.
Don't use brackets round the parameters! They're only used if you use the redundant 'Call' statement or for Functions where a value is returned.
Insert_Pic_From_File2 "D:\Area Open\ok.png", y, col_result
should be fine

Overflow error on VB6 program running on Win XP

I'm getting a error message in a VB6 .exe file running on Windows XP.
I compile and "make it" on Windows 7/8, but always get an Overflow error message when it executes this two lines on XP:
sUrl = "C:\Arquivos de Programas\Internet Explorer\IEXPLORE.EXE http://example.com/WebForms/send.aspx?id=" & intCodID & "&type=500&usr=" & intCodUser
openWeb = Shell(sUrl, vbMaximizedFocus)
sUrl is a String and OpenWeb is actually a Integer, but I already declared it as Double and as nothing (just Dim OpenWeb) and still get the overflow error.
UPDATE
Didn't managed to find out what was happening there, but another solution for calling IE:
Dim IE
sUrl = "http://www.google.com/"
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
IE.Navigate sUrl
While the VB6 documentation says Shell() returns a Variant Double... that appears to be obsolete information left over from manuals for earler versions of VB. Instead if you check the typelib info (i.e. look in the IDE's Object Browser) it actually returns a Double type result value.
As far as I can tell Shell() is a wrapper around a call to the WinExec() function.
The returned values are:
0 The system is out of memory or resources.
ERROR_BAD_FORMAT = 11 The .exe file is invalid.
ERROR_FILE_NOT_FOUND = 2 The specified file was not found.
ERROR_PATH_NOT_FOUND = 3 The specified path was not found.
or a Process ID
Also contrary to the documentation, Shell() turns those error values into exceptions ("File not found", "Invalid procedure call or argument," etc.). So if the call succeeds you always get back a PID value.
In all cases this is a DWORD. So it always fits in a Double without the possibility of an overflow. If you are seeing an overflow there is something else going wrong in your code.
Sadly a Double isn't particularly useful here, though it can at least hold the entire range of values. But you'd normally want to carefully convert it to a Long value:
Option Explicit
Function DDoubleToDLong(ByVal DDouble As Double) As Long
'Some functions like the intrinsic Shell() return a Double
'to get around the lack of a UI4 type (DWORD, i.e. unsigned
'Long) in VB. Of course this isn't clean to pass to API
'calls, making it sort of worthless so we need to do a type
'conversion such as this:
If DDouble > 2147483647# Then
DDoubleToDLong = CLng(DDouble - 2147483648#) Or &H80000000
Else
DDoubleToDLong = CLng(DDouble)
End If
End Function
Private Sub Form_Load()
Dim DD As Double
Dim DL As Long
AutoRedraw = True
Font.Name = "Courier New" 'Or other handy monospaced font.
Font.Size = 12#
DD = 0#: DL = DDoubleToDLong(DD): Print DD, DL, Hex$(DL)
DD = 1#: DL = DDoubleToDLong(DD): Print DD, DL, Hex$(DL)
DD = 2147483647#: DL = DDoubleToDLong(DD): Print DD, DL, Hex$(DL)
DD = 2147483648#: DL = DDoubleToDLong(DD): Print DD, DL, Hex$(DL)
DD = 4294967295#: DL = DDoubleToDLong(DD): Print DD, DL, Hex$(DL)
End Sub
Integer is worthless since overflows will be common. Long without the conversion could cause overflows now and then. String is just silly.
You also need to quote the values for the EXE and its arguments property, as in:
Option Explicit
Function DDoubleToDLong(ByVal DDouble As Double) As Long
If DDouble > 2147483647# Then
DDoubleToDLong = CLng(DDouble - 2147483648#) Or &H80000000
Else
DDoubleToDLong = CLng(DDouble)
End If
End Function
Private Sub Form_Load()
Dim sUrl As String
Dim PID As Long
sUrl = """C:\Arquivos de Programas\Internet Explorer\IEXPLORE.EXE"" " _
& """http://example.com/WebForms/send.aspx?id=" _
& intCodID _
& "&type=500&usr=" _
& intCodUser _
& """"
PID = DDoubleToDLong(Shell(sUrl, vbMaximizedFocus))
End Sub
Even this isn't quite "right" since exception handling should be added. And both intCodID and intCodUser may require "cleansing" (UrlEncoding) depending on what types they are and what values they really have. These might be Integers based on the names, with you relying on implicit String coercion? If so they might be Ok.
BTW, as we see above special folder names get localized. For that matter the system drive might not even be C:\ at all! So such paths should never be hard-coded but instead be built up based on values returned from calls to Shell32 to look up the special folder.
An integer can only be a whole number. No decimals.
You say it's declared as an integer therefore you cannot assign 1. anything, and you certainly can't assign anything like that to a number variable as it's not a valid number anyway as it has two decimal points.
You need to declare it as string.

Error System.Runtime.InteropServices.COMException

I got a problem with a project I'm making
it's program that gets signature from a wacom
sign pad It works fine at first run then whenever
I try to enter another signature for the second
time it gets this error message
Here is the code:
Dim sigCtl As New SigCtl
Dim dc As New DynamicCapture
Dim res As DynamicCaptureResult
sigCtl.Licence = "AgAZAPZTkH0EBVdhY29tClNESyBTYW1wbGUBAoECA2UA"
res = dc.Capture(sigCtl, "who", "why", vbNull, vbNull)
If (res = DynamicCaptureResult.DynCaptOK) Then
print("signature captured successfully")
Dim sigObj As SigObj
sigObj = sigCtl.Signature
sigObj.ExtraData("AdditionalData") = "VB test: Additional data"
Dim filename As New String("sig1.png")
sigObj.RenderBitmap(filename, 200, 150, "image/png", 0.5F, &HFF0000, &HFFFFFF, -1.0F, -1.0F, _
RBFlags.RenderOutputFilename Or RBFlags.RenderColor32BPP Or RBFlags.RenderEncodeData)
sigImage.Load(filename)
Else
print("Signature capture error res=" & res)
Select Case res
Case DynamicCaptureResult.DynCaptCancel
print("signature cancelled")
Case DynamicCaptureResult.DynCaptError
print("no capture service available")
Case DynamicCaptureResult.DynCaptPadError
print("signing device error")
Case Else
print("Unexpected error code ")
End Select
End If
The error occurs around sigobj.rederbitmap syntax it gives of the System.Runtime.InteropServices.COMException exception
I'm kinda puzzled whats wrong here since it always work at first try
Thanks in advance*strong text*
I had the same problem with a wacom STU-530 device.
What worked for me was to change the filename string each time the user wanted to use another test.
Dim rndm As New Random
Dim serial As Integer = rndm.Next(1, 9999)
Dim str_serial As String = CStr(serial)
Dim filename As New String("sig_" & str_serial.PadLeft(4, "0") & ".png")

Mac querytables

I have written a script which downloads data from yahoo finance into excel using querytable. It should loop through each URL and download the data but it can't get past the second loop and fails at the .Refresh BackroundQuery:=False with the error code 1004 - An unexpected error has occurred.
Here is the code:
rowOffset = 0
url = Worksheets("Yahoo codes").Range("b2").Offset(rowOffset, 0)
Do While url <> ""
With ActiveSheet.QueryTables.Add(Connection:="URL;" & url, Destination:=Worksheets("Yahoo Data").Range("A65536").End(xlUp).Offset(1, 0))
.RefreshStyle = xlOverwriteCells
.SaveData = True
.BackgroundQuery = True
.Refresh BackgroundQuery:=False
'.Refresh
End With
rowOffset = rowOffset + 1
url = Worksheets("Yahoo Data").Range("a2").Offset(rowOffset, 0)
Loop
It looks like you get the first URL from B2 and subsequent URLs from A3...
When you get the error, got to the Immediate Window (Ctl+G) and type
?Worksheets("Yahoo Data").QueryTables(2).Connection
and see if it looks right. If not, I suspect your second url = ... statement is wrong.

Resources