I want to use the new JScript features in IE9 (native json, ...) from a VB6 Host.
From what I've read (see http://blogs.msdn.com/b/jscript/archive/2009/04/17/versioning-language-features-in-jscript.aspx), I have to invoke the IActiveScriptProperty::SetProperty and set SCRIPTPROP_INVOKEVERSIONING to 2 (SCRIPTLANGUAGEVERSION_5_8). So, I have added the interface to my odl file:
...
[
odl,
uuid(4954E0D0-FBC7-11D1-8410-006008C3FBFC),
]
interface IActiveScriptProperty : stdole.IUnknown
{
HRESULT GetProperty(
[in] LONG dwProperty,
[in] VARIANT *pvarIndex,
[out] VARIANT *pvarValue
);
HRESULT SetProperty(
[in] LONG dwProperty,
[in] VARIANT *pvarIndex,
[in] VARIANT *pvarValue
);
}
...
In the VB6 host, I create the engine with:
Dim hRes as Long
Dim IUnk as IUnknown
Dim clsidJS as UUID
Dim uuidActScr as UUID
Dim IProperty as IActiveScriptProperty
Dim IScript As IActiveScript
Dim IParse As IActiveScriptParse
' Create the engine
CLSIDFromString "{16d51579-a30b-4c8b-a276-0ff4dc41e755}", clsidJS ' JScript9 (Chakra)
CLSIDFromString IID_IActiveScript, uuidActScr
hRes = CoCreateInstance(clsidJS, Nothing, CLSCTX_INPROC_SERVER, uuidActScr, IUnk)
' Set version
Const SCRIPTPROP_INVOKEVERSIONING As Long = &H4000
Dim Version as Variant
Version = 2
Set IProperty = iUnk
IProperty.SetProperty SCRIPTPROP_INVOKEVERSIONING, 0, Version '<--- Here I get error 5 "Invalid procedure call or argument"
In the last comment of the previous article, Byron says:
"The undocumented 'feature' of the SetProperty with SCRIPTPTOP_INVOKEVERSIONING is that the value must be a VT_I4 or VT_I2 - any other integer type will be rejected as invalid."
So I modify the above code to (VariantType property comes from http://www.xbeat.net/vbspeed/i_OpenODL.htm#VBVM6Lib):
...
Version = 2
VariantType(Version) = VT_I4 ' Force VT_I4 variant type
Set IProperty = iUnk
IProperty.SetProperty SCRIPTPROP_INVOKEVERSIONING, 0, Version '<--- Here I get the same error 5 "Invalid procedure call or argument"
NOTE: If I don't try to set SCRIPTPROP_INVOKEVERSIONING property, the engine works ok and if I run:
ScriptEngineMajorVersion() + "." + ScriptEngineMinorVersion() + "." + ScriptEngineBuildVersion()
I get "9.0.16457', but I don't have access to the new features as native json.
Any ideas?
Thanks!
You have to change declaration ot SetProperty to
HRESULT SetProperty(
[in] LONG dwProperty,
[in] void *pvarIndex,
[in] VARIANT *pvarValue
);
to be able to set index-less properties. Just pass 0 (NULL) as you did in your sample code. Present declaration treats SCRIPTPROP_INVOKEVERSIONING as an array and you are setting first index to some value.
Mind that VT_I2 = Integer in VB6 and VT_I4 = Long, so no need to hack these. Just use 2 or 2& or Private Const SCRIPTLANGUAGEVERSION_5_8 As Long = 2 and the const will be correctly typed.
Also note that on this line hRes = CoCreateInstance(clsidJS, Nothing, CLSCTX_INPROC_SERVER, uuidActScr, IUnk) you are already getting IActiveScript interface. No need later to cast Set IProperty = iUnk.
It all depends how you declare CoCreateInstance -- using void * for last param will allow you to directly pass IProperty variable and get it initialized with the IActiveScript interface of clsidJS.
Related
Nim Compiler Version 1.6.6 [Windows: i386]
Compiled at 2022-05-05
Copyright (c) 2006-2021 by Andreas Rumpf
active boot switches: -d:release
Cmd Compile
nim c --cpu:i386 -d:release --app:lib --nomain mydll.nim
Hi there, I was able to return a Long value, now I'm trying to get string values.
I googled to find some exemples and find out here:
https://my.oschina.net/yuekcc/blog/775990
I'm getting this error:
VB6:
Private Declare Function MyStr Lib "mydll.dll" (ByVal s As String) As String
Private Declare Function return_multiply Lib "mydll.dll" Alias "return_multiply#8" (ByVal a As Long, ByVal b As Long) As Long
Private Sub Form_Click()
MsgBox MyStr("?") 'error
MsgBox return_multiply(5, 4) 'ok
End Sub
Another question, why the Alias has #8 at the end? return_multiply#8
Nim:
import encodings
const
vbCodePage = "GB2312"
vbTrue* = 1
vbFalse* = 0
type
VBString* = cstring
VBBoolean* = int32
proc MyStr*(): cstring {.stdcall, exportc, dynlib.} =
result = $"teste"
proc fromVBString*(a: VBString): string =
return encodings.convert($a, "UTF-8", vbCodePage)
proc toVBString*(a: string): VBString =
return VBString(encodings.convert(a, vbCodePage, "UTF-8"))
proc return_multiply*(a, b: int): int {.stdcall, exportc, dynlib.} =
a * b
Since you want to export toVBString in the dynamic library, you have to add the exportc, dynlib pragmas to it as to others:
proc toVBString*(a: string): VBString {.exportc, dynlib, stdcall.} =
return VBString(encodings.convert(a, vbCodePage, "UTF-8"))
But the definition is wrong anyway - I don't know what type VB's String is, but it certainly is different from the Nim string, and I'm not sure why you are importing it in your VB program.
Also, I don't think it's correct to just convert the Nim string to cstring to pass it to VB - Nim's cstring doesn't actually "own" the string data, so when the Nim runtime frees the Nim string, the cstring of it will point to invalid data. I don't know if VB has specific APIs for that or not though.
I know nothing about Nim, but the way to create a VB string is to make an OLE BSTR. SysAllocStringLen() would probably be your best bet. Others in that family might be better depending on what your string data looks like and where it comes from. Check out the MS docs.
I am trying to get the UserAgent of the default browser using the ObtainUserAgentString API in Visual Basic 6. I found the documentation on the MSDN and tried to convert it to Visual Basic 6 but it did not work.
C++ (MSDN)
HRESULT ObtainUserAgentString(
_In_ DWORD dwOption = 0,
_Out_ LPCSTR *pcszUAOut,
_Out_ DWORD *cbSize
);
Visual Basic 6 API
Private Declare Function ObtainUserAgentString Lib "Urlmon.dll" (ByVal dwOption As Long, ByRef pcszUAOut As String, ByRef cbSize As Long) As Long
Private Function BrowserUserAgent() As String
Dim httpUseragent As String
Dim szhttpUserAgent As Long
httpUseragent = Space(512)
szhttpUserAgent = Len(httpUseragent)
Call ObtainUserAgentString(0, httpUseragent, szhttpUserAgent)
BrowserUserAgent = httpUseragent
End Function
Private Sub Command1_Click()
MsgBox BrowserUserAgent
End Sub
Aside from the fact this is a cruddy old ANSI entrypoint, everything you need appears to be documented.
Option Explicit
Private Const NOERROR As Long = 0
Private Const E_OUTOFMEMORY As Long = &H8007000E
Private Enum UAS_OPTIONSENUM
[_UAS_EXACTLEGACY] = &H1000&
UAS_DEFAULT = 0
UAS_7 = 7 'Compatible mode.
UAS_7_LEGACY = 7 Or [_UAS_EXACTLEGACY]
UAS_8 = 8
UAS_9 = 9
UAS_10 = 10
UAS_11 = 11
End Enum
Private Declare Function ObtainUserAgentString Lib "urlmon" ( _
ByVal dwOption As Long, _
ByVal pcszUAOut As Long, _
ByRef cbSize As Long) As Long
Private Function BrowserUserAgent( _
Optional ByVal Options As UAS_OPTIONSENUM = UAS_DEFAULT) As String
Const MAX_BUFFER As Long = 2048
Dim Size As Long
Dim Buffer() As Byte
Dim HRESULT As Long
Do
Size = Size + 128
ReDim Buffer(Size - 1)
HRESULT = ObtainUserAgentString(Options, VarPtr(Buffer(0)), Size)
Loop While HRESULT = E_OUTOFMEMORY And Size < MAX_BUFFER
If HRESULT = NOERROR Then
BrowserUserAgent = StrConv(LeftB$(Buffer, Size - 1), vbUnicode)
Else
Err.Raise &H8004D000, _
, _
"ObtainUserAgentString error &H" & Hex$(HRESULT)
End If
End Function
Private Sub Form_Load()
AutoRedraw = True
Print BrowserUserAgent()
Print BrowserUserAgent(UAS_7)
Print BrowserUserAgent(UAS_7_LEGACY)
Print BrowserUserAgent(UAS_8)
Print BrowserUserAgent(UAS_11)
End Sub
HRESULT ObtainUserAgentString(
_In_ DWORD dwOption = 0,
_Out_ LPCSTR *pcszUAOut,
_Out_ DWORD *cbSize
);
Param 2 is LongPointerCString. You always pass C strings ByVal which in reality passes the C string part of the B String ByRef. If it was a IN param you would have to end the string with a Chr(0) which is what real C strings have.
String arguments are a special case. Passing a string by value means you are passing the address of the first data byte in the string; passing a string by reference means you are passing the memory address where another address is stored; the second address actually refers to the first data byte of the string. How you determine which approach to use is explained in the topic "Passing Strings to a DLL Procedure" later in this chapter.
From Visual Basic Concepts in Help.
My software (written in VB6) needs to import csv files that can be large. Users are using copy/paste to place the files in the input folder.
How can I be sure the files I want to read are fully copied before processing them?
Things I tried :
Compare GetFileSizeString over a span of seconds : doesn't work, I get the final value even if the file has just begun to copy.
FileSystemObject.DateLastModified : same
FileSystemObject.DateLastAccessed : same
FileLen : same
FileDateTime : same
EDIT - Added Samba/Linux Info (from comments):
I'm having a hard time dealing with is from Samba/Linux. I don't know why, but when the file is copied by Samba, the read only attribute doesn't matter.
I've used this method which uses the API to test for exclusive access. I've never tried it on a platform other than Windows so, I guess result may vary. I use this in a module of frequently used methods, but I believe I have included the API calls, types, and constants used.
Private Const ERROR_SHARING_VIOLATION = 32&
Private Const GENERIC_WRITE = &H40000000
Private Const INVALID_HANDLE_VALUE = -1
Private Const OPEN_EXISTING = 3
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Any) As Long
Public Function CanOpenExclusive(ByVal vFileName As String) As Boolean
Dim lngResult As Long
Dim udtSA As SECURITY_ATTRIBUTES
On Error GoTo errCanOpenExclusive
If Len(vFileName) > 0 Then
udtSA.nLength = Len(udtSA)
udtSA.bInheritHandle = 1&
udtSA.lpSecurityDescriptor = 0&
lngResult = CreateFile(vFileName, GENERIC_WRITE, 0&, udtSA, OPEN_EXISTING, 0&, 0&)
If lngResult <> INVALID_HANDLE_VALUE Then
Call CloseHandle(lngResult)
CanOpenExclusive = True
Else
Select Case Err.LastDllError 'some errors may indicate the file exists, but there was an error opening it
Case Is = ERROR_SHARING_VIOLATION
CanOpenExclusive = False
Case Else
GoTo errCanOpenExclusive
End Select
End If
End If
Exit Function
errCanOpenExclusive:
Err.Raise Err.Number, Err.Source & ":CanOpenExclusive", Err.Description
End Function
I would use the FileDateTime function to work with to calculate when a date/time value indicating the date and time that a file was created or last modified.
You can read up more on the file system usage HERE.
In the syntax above, pathname is a string expression specifying a valid path (it may optionally include the drive); drive is a string expression specifying a drive letter; and filespec, oldfilespec, and newfilespec are string expressions that specify a file (they may optionally include the drive and path).
Following is a set of functions that can be used with files (all are functions except SetAttr, which is a statement):
Function
Description
Syntax
FileDateTime
Returns a date/time value indicating the date and time that a file was created or last modified.
FileDateTime(filespec)
GetAttr
Returns an integer representing the attributes of a file, directory, or folder
GetAttr(filespec)
SetAttr
Statement that lets you specify the attributes for a file
SetAttr(filespec, attributes)
CurDir$ (or CurDir)
Returns a string that indicates the current path for a specified disk drive. In the syntax on the right, drivename is a string expression that specifies a valid disk drive designation
CurDir$(drivename)
Dir$ (or DIr)
Returns a string that indicates a file or directory matching specified conditions
Dir$(filespec [,attributes])
FileLen
Returns a Long specifying the length of a file in bytes. If the specified file is open when the FileLen function is called, the value returned represents the size of the file immediately before it was opened.
FileLen(pathname)
LOF
Returns a Long representing the size, in bytes, of a file opened using the Open statement.
FileLen(filenumber)
Hi I need your help guys!
I am new to the system I am using and I am working on customizing a report that uses crystal report,
I need to get the value of the last page and compare this to the current page
(CurrentPage <> LastPage) , yet the data type of the Last Page is set to string/char..
I guess this is the reason why I can't get the result on the condition above. is there any way to change
its data type to Integer? or is there other way to get the LastPage integer value from a crystal reports without using the set variables for last page?
Thank You.
Remember that ALL textbox values is always a string value no matter of the content.
'Private Sub TextBox1_Change()
Dim IntValue As Integer
If TextBox1.TextLength > 0 Then
IntValue = TextBox1 * 1 ' method 1
'IntValue = TextBox1 + 1 - 1 ' method 2
'IntValue = TextBox1 + 0 ' method 3
MsgBox "IntValue = " & IntValue
End If
End Sub'
CInt specifies the integer datatype. VBScript normally autoconverts.
I have a different user id so ihave to reply here. This is a variant,
struct tagVARIANT {
VARTYPE vt;
WORD wReserved1;
WORD wReserved2;
WORD wReserved3;
union {
// C++ Type Union Name Type Tag Basic Type
// -------- ---------- -------- ----------
long lVal; // VT_I4 ByVal Long
unsigned char bVal; // VT_UI1 ByVal Byte
short iVal; // VT_I2 ByVal Integer
float fltVal; // VT_R4 ByVal Single
double dblVal; // VT_R8 ByVal Double
VARIANT_BOOL boolVal; // VT_BOOL ByVal Boolean
SCODE scode; // VT_ERROR
CY cyVal; // VT_CY ByVal Currency
DATE date; // VT_DATE ByVal Date
BSTR bstrVal; // VT_BSTR ByVal String
IUnknown *punkVal; // VT_UNKNOWN
IDispatch *pdispVal; // VT_DISPATCH ByVal Object
SAFEARRAY *parray; // VT_ARRAY|* ByVal array
// A bunch of other types that don't matter here...
VARIANT *pvarVal; // VT_BYREF|VT_VARIANT ByRef Variant
void * byref; // Generic ByRef
};
};
Variants normally autoconvert, need a string it changes to a string.
This is one OLE function (and probably what VB uses)
HRESULT VariantChangeType(VARIANT * pvDst, VARIANT * pvSrc, WORD wFlags, VARTYPE vt);
This function changes the type of a VARIANT without changing its value (if possible). To change a variable in place, make the destination the same as the source.
CInt forces it to be an integer, even if vbscript think it should be something else.
So a string containing 52 will be an integer if you try and add another number to it.
Also in basic a int is 16 bit and a long is 32 bit for compatability with 16 bit VB.
We have VBA code in a Word macro that is used to download one or more documents, then print them using the Windows function ShellExecuteEx. The code runs successfully in Word versions 97, 2000, 2003, 2007 and 2010 (32-bit) on Windows 2000, XP and 7 (32-bit and 64-bit).
But the call to ShellExecuteEx fails in 64-bit Word 2010 and 2013. We have updated the declarations for VBA7 (64-bit) as documented on MSDN and specified in the Win32API_PtrSafe file. For example:
#If VBA7 Then
Type SHELLEXECUTEINFO
cbSize As Long
fMask As Long
hwnd As LongPtr
lpVerb As String
lpFile As String
lpParameters As String
lpDirectory As String
nShow As Long
hInstApp As LongPtr
lpIDList As LongPtr
lpClass As String
hkeyClass As LongPtr
dwHotKey As Long
hIcon As LongPtr
hProcess As LongPtr
End Type
Declare PtrSafe Function ShellExecuteEx Lib "shell32.dll" Alias "ShellExecuteExA" _
(sei As SHELLEXECUTEINFO) As Boolean
#End If
Usage is like this:
Dim bReturn As Boolean
Dim sei As SHELLEXECUTEINFO
With sei
.cbSize = Len(sei) ' size of the object
.fMask = SEE_MASK_NOCLOSEPROCESS ' indicate that we want a hProcess back
.hwnd = GetDesktopWindow() ' the window we are calling from
.lpVerb = "print" ' print the file
.lpFile = lpFile ' the file we want to print
.lpParameters = vbNullString ' no parameters because its a file
.lpDirectory = vbNullString ' use the current dir as working dir
.nShow = SW_HIDE ' state of the window to open
End With
bReturn = ShellExecuteEx(sei)
If bReturn Then
WaitForSingleObject sei.hProcess, 5000
CloseHandle sei.hProcess
DoEvents
Else
MsgBox "ShellExecuteEx failed with code: " & Err.LastDllError
End If
In 32-bit Word it works but in 64-bit Word the call to ShellExecuteEx always fails, returning 5 (SE_ERR_ACCESSDENIED). I have tried a range of flag values for fMask (including SEE_MASK_NOASYNC), tried not specifying a value for hwnd and different values for nShow, all with the same failed result.
The simpler ShellExecute function works in both 32-bit and 64-bit Word but it is too inflexible. We want to use ShellExecuteEx because it is better when printing multiple documents: it gives us the ability to wait for the printing application (Word, Adobe Reader etc.) to be ready before sending another print request. Otherwise a print request fails if the application is not ready. (I tried simply waiting for a few seconds between print requests but that is not reliable.)
Why does ShellExecute print files but ShellExecuteEx fail with access denied?
You have to use LenB instead of Len for 64 version OS.
The whole answer is here: http://www.utteraccess.com/forum/office-2010-x64-bit-qu-t1914261.html