OSDN > Find Software > Software Development > Libraries > vds-ole-bridge > SCM > hg > VDS_OLE_Bridge > Commit

vds-ole-bridge
Fork

VDS_OLE_Bridge: Commit

OLE bridge for Visual DialogScript

Commit MetaInfo

Revision	7b0b6c9522b8c58865a584f8780ebac97b9e8654 (tree)
Time	2019-01-30 09:08:38
Author	Levashev Ivan　卜根 <bu_ <gen@octa...>
Commiter	Levashev Ivan　卜根 <bu_

Log Message

Importing code from work PC

Change Summary

Incremental Difference

diff -r 000000000000 -r 7b0b6c9522b8 LICENSE.txt

--- /dev/null Thu Jan 01 00:00:00 1970 +0000

+++ b/LICENSE.txt Wed Jan 30 03:08:38 2019 +0300

		@@ -0,0 +1,18 @@
	1	+Copyright 2019 Levashev Ivan Aleksandrovich
	2	+
	3	+Licensed under the Apache License, Version 2.0 (the "License");
	4	+you may not use this file except in compliance with the License.
	5	+You may obtain a copy of the License at
	6	+
	7	+ http://www.apache.org/licenses/LICENSE-2.0
	8	+
	9	+Unless required by applicable law or agreed to in writing, software
	10	+distributed under the License is distributed on an "AS IS" BASIS,
	11	+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
	12	+See the License for the specific language governing permissions and
	13	+limitations under the License.
	14	+
	15	+
	16	+Fragments of code are licensed under GPLv3 with Runtime Exception, as
	17	+indicated in specific files, in their header comments. COPYING3 and
	18	+COPYING.RUNTIME are ONLY applicable to these specific files.

diff -r 000000000000 -r 7b0b6c9522b8 OLE Aut API.txt

--- /dev/null Thu Jan 01 00:00:00 1970 +0000

+++ b/OLE Aut API.txt Wed Jan 30 03:08:38 2019 +0300

		@@ -0,0 +1,243 @@
	1	+=== Initialization ===
	2	+
	3	+#DEFINE COMMAND, OLE
	4	+#DEFINE FUNCTION, OLE
	5	+EXTERNAL VDSOLEAUT.DLL[,ignored]
	6	+
	7	+=== A comment about OLE and COIN variants ===
	8	+
	9	+OLE and COIN (JSON, YAML) variants exist in different spaces.
	10	+Their numbers are completetly independent. COIN (JSON, YAML)
	11	+variants are structured entities heavily tied to JSON and
	12	+YAML. OLE variants are nothing but either plain values or
	13	+object references. Different OLE types are there to only make
	14	+calls to OLE objects.
	15	+
	16	+=== OLE Variant API ===
	17	+
	18	+Deallocation:
	19	+OLE CLOSE, variant, %V
	20	+
	21	+Deallocates variant #%V . Has no effect if already deallocated.
	22	+
	23	+OLE CLOSE, variant, ALL
	24	+
	25	+Deallocates all variants if any.
	26	+
	27	+
	28	+Type of:
	29	+%D = @OLE(variant, %V, TYPEOF)
	30	+
	31	+Returns type of variant #%V. Known types are:
	32	+STRING, INTEGER, BOOLEAN, REAL, OBJECT, NULL, UNDEFINED, DATETIME, UNKNOWN.
	33	+
	34	+
	35	+Serialization:
	36	+%D = @OLE(variant, %V, TOSTRING)
	37	+%D = @OLE(variant, %V, TOUTF)
	38	+
	39	+Returns string representation of variant #%V. ANSI or UTF-8.
	40	+
	41	+
	42	+Create variant:
	43	+%V = @OLE(variant, 23, {STRING/UTF/INTEGER/BOOLEAN/REAL})
	44	+%V = @OLE(variant, class name, {OBJECT/THREADEDOBJECT})
	45	+
	46	+Allocates new variant with specific value of specific type.
	47	+"SAPI.SpVoice, OBJECT" would create new OLE object of registered
	48	+SAPI.SpVoice class name. THREADEDOBJECT acts like OBJECT, but
	49	+creates object in the MTA. All calls work slower, but
	50	+asynchronous interaction is possible.
	51	+
	52	+
	53	+Enumerate:
	54	+%E = @OLE(variant, %V, ENUMERATE)
	55	+
	56	+Creates new enumerator #%E (should be deallocated).
	57	+
	58	+
	59	+Query object property:
	60	+%Y = @OLE(variant, %V, GET, variant, name[, value, [Name:]type...])
	61	+
	62	+Get property name[index, index, index, ...] where each index is
	63	+described by pair (value, [Name:]type).
	64	+
	65	+%Y is new variant id (should be deallocated).
	66	+
	67	+%Y = @OLE(variant, %V, GET, {string/utf}, name[, value, [Name:]type...])
	68	+
	69	+%Y is string representation in either ANSI or UTF-8.
	70	+
	71	+%P = @OLE(variant, %V, GET, promise, name[, value, [Name:]type...])
	72	+
	73	+%P is new promise id (should be deallocated). Callee, method name and arguments
	74	+are bound in the main thread, then execution continues in background thread.
	75	+When execution finishes, @EVENT() OLEASYNCEVENT is generated with @MSGPARAMS(W)
	76	+set to be promise id. Object in variant #%V must have been created in the MTA
	77	+(THREADEDOBJECT). Otherwise COM forces synchronous execution in the main thread.
	78	+
	79	+%E = @OLE(variant, %V, GET, enumerator, name[, value, [Name:]type...])
	80	+
	81	+#%E is new enumerator (should be deallocated).
	82	+
	83	+
	84	+Set object property:
	85	+OLE MODIFY, variant, %V, PUT, name[, value, [Name:]type...], value, type
	86	+
	87	+Set property name[index, index, index, ...] to be item where
	88	+each index and item are described by pair "value, type".
	89	+
	90	+%P = @OLE(variant, %V, PUT, promise, name[, value, [Name:]type...])
	91	+
	92	+%P is new promise id (should be deallocated). Callee, method name and arguments
	93	+are bound in the main thread, then execution continues in background thread.
	94	+When execution finishes, @EVENT() OLEASYNCEVENT is generated with @MSGPARAMS(W)
	95	+set to be promise id. Object in variant #%V must have been created in the MTA
	96	+(THREADEDOBJECT). Otherwise COM forces synchronous execution in the main thread.
	97	+
	98	+
	99	+Invoke object method:
	100	+%Y = @OLE(variant, %V, DO, variant, name[, value, [Name:]type...])
	101	+OLE INVOKE, variant, %V, DO, name[, value, [Name:]type...]
	102	+
	103	+Invokes method name(argument, argument, ...) where each argument is
	104	+described by "value, type" pair. "Name:type" syntax can be used for
	105	+named parameters (makes sense for e.g. MS Word Search with tons of
	106	+parametes). Named parameters must follow positional parameters.
	107	+
	108	+%Y is new variant id (should be deallocated).
	109	+
	110	+%Y = @OLE(variant, %V, DO, {string/utf}, name[, value, [Name:]type...])
	111	+
	112	+%Y is string representation (ANSI or UTF-8).
	113	+
	114	+%P = @OLE(variant, %V, DO, promise, name[, value, [Name:]type...])
	115	+
	116	+%P is new promise id (should be deallocated). Callee, method name and arguments
	117	+are bound in the main thread, then execution continues in background thread.
	118	+When execution finishes, @EVENT() OLEASYNCEVENT is generated with @MSGPARAMS(W)
	119	+set to be promise id. Object in variant #%V must have been created in the MTA
	120	+(THREADEDOBJECT). Otherwise COM forces synchronous execution in the main thread.
	121	+
	122	+%E = @OLE(variant, %V, DO, enumerator, name[, value, [Name:]type...])
	123	+
	124	+#%E is new enumerator (should be deallocated).
	125	+
	126	+
	127	+=== OLE Enumerator API ===
	128	+
	129	+Deallocation:
	130	+OLE CLOSE, enumerator, %E
	131	+
	132	+Deallocates enumerator #%E . Has no effect if already deallocated.
	133	+
	134	+OLE CLOSE, enumerator, ALL
	135	+
	136	+Deallocates all enumerators if any.
	137	+
	138	+
	139	+Query next item:
	140	+%Y = @OLE(enumerator, %E, NEXT)
	141	+
	142	+%Y is new variant id (should be deallocated).
	143	+
	144	+
	145	+=== Promises ===
	146	+
	147	+Deallocation:
	148	+OLE CLOSE, promise, %P
	149	+
	150	+Deallocates promise #%P . Execution does not abort, but there will be no notification.
	151	+
	152	+OLE CLOSE, promise, ALL
	153	+
	154	+Deallocates all promises. Execution does not abort, but there will be no notification.
	155	+
	156	+
	157	+Completion test:
	158	+%B = @OLE(promise, %P, ISCOMPLETED)
	159	+
	160	+Checks if promise #%P is completed. Returns either "TRUE" or empty string.
	161	+
	162	+%B = @OLE(promise, %P, ISRUNNING)
	163	+
	164	+Checks if promise #%P is still running. Returns either "TRUE" or empty string.
	165	+
	166	+
	167	+Value query:
	168	+%Y = @OLE(promise, %P, VALUE)
	169	+
	170	+%Y is new variant id (should be deallocated).
	171	+
	172	+%Y = @OLE(promise, %P, {TOSTRING/TOUTF})
	173	+
	174	+%Y is string representation in either ANSI or UTF-8.
	175	+
	176	+
	177	+
	178	+=== Examples ===
	179	+
	180	+%S = @OLE(variant, SAPI.SpVoice, THREADEDOBJECT)
	181	+
	182	+INFO SAPI.SpVoice created with type @OLE(variant, %S, TYPEOF)
	183	+# OBJECT if Speech API is installed
	184	+
	185	+OLE INVOKE, variant, %S, DO, Speak, This is a test, STRING
	186	+# Speak text synchronously with default voice
	187	+
	188	+%P = @OLE(variant, %S, DO, promise, Speak, This is another test. You should hear speech and see message at the same time, STRING)
	189	+# Speak text asynchronously with default voice
	190	+
	191	+INFO Asynchronous method invocation
	192	+# One should see this message in parallel with actual voice
	193	+
	194	+WHILE @OLE(promise, %P, ISRUNNING)
	195	+ # WAIT EVENT
	196	+ # Only valid when dialog is displayed
	197	+
	198	+ WAIT 1
	199	+ # UI is responding while background thread executes
	200	+WEND
	201	+
	202	+OLE CLOSE, promise, %P
	203	+
	204	+INFO Volume property by default: @OLE(variant, %S, GET, string, Volume)
	205	+# 100 by default
	206	+
	207	+OLE MODIFY, variant, %S, PUT, Volume, 80, INTEGER
	208	+# Set volume to 80
	209	+
	210	+INFO Volume property after synchronous modification: @OLE(variant, %S, GET, string, Volume)
	211	+# Now it is 80
	212	+
	213	+%P = @OLE(variant, %S, PUT, promise, Volume, 100, INTEGER)
	214	+# Asynchronous property modification
	215	+
	216	+INFO Volume property after asynchronous modification: @OLE(variant, %S, GET, string, Volume)
	217	+# Can be still 80 if background thread starts slow (didn't manage to get this)
	218	+# Changes to 100 if THREADEDOBJECT changed to OBJECT in the beginning
	219	+
	220	+WHILE @OLE(promise, %P, ISRUNNING)
	221	+ WAIT 1
	222	+ # UI is responding while background thread executes
	223	+WEND
	224	+
	225	+INFO Volume property after waiting for completion: @OLE(variant, %S, GET, string, Volume)
	226	+
	227	+OLE CLOSE, promise, %P
	228	+
	229	+%V = @OLE(variant, %S, DO, variant, GetVoices)
	230	+%E = @OLE(variant, %V, ENUMERATE)
	231	+OLE CLOSE, variant, %V
	232	+
	233	+%V = @OLE(enumerator, %E, NEXT)
	234	+WHILE %V
	235	+ INFO Voice detected: @OLE(variant, %V, DO, string, GetDescription)
	236	+
	237	+ OLE CLOSE, variant, %V
	238	+ %V = @OLE(enumerator, %E, NEXT)
	239	+WEND
	240	+
	241	+OLE CLOSE, enumerator, %E
	242	+
	243	+OLE CLOSE, variant, %S

diff -r 000000000000 -r 7b0b6c9522b8 README.txt

--- /dev/null Thu Jan 01 00:00:00 1970 +0000

+++ b/README.txt Wed Jan 30 03:08:38 2019 +0300

		@@ -0,0 +1,24 @@
	1	+OLE Automation bridge for Visual DialogScript
	2	+
	3	+Author: Levashev Ivan Aleksandrovich
	4	+bu_gen@octagram.name
	5	+
	6	+Many Win32 libraries have OLE Automation interface. For instance, WinSCP is a
	7	+.NET library, and it can have OLE Automation interface. Speech API is another
	8	+example.
	9	+
	10	+This library also serves as a demonstration of my skills. In contrast to many
	11	+other OLE Automation bridges (almost all of them) it supports multithreading.
	12	+It correctly marshals objects from STA to MTA and vice versa. Speech API
	13	+sample demonstrates possible usage. Background WinSCP transfer is another
	14	+option, though not explored in samples.
	15	+
	16	+Documentation: see "OLE Aut API.txt" for reference.
	17	+
	18	+Current homepage:
	19	+https://osdn.net/projects/vds-ole-bridge/scm/hg/VDS_OLE_Bridge/
	20	+
	21	+Compilation:
	22	+
	23	+Pre-Unicode Delphi is required (7 .. 2007). I used to write Unicode-agnostic
	24	+code, but that was a way too tough case, I gave up.

diff -r 000000000000 -r 7b0b6c9522b8 SCPTester.dsc

--- /dev/null Thu Jan 01 00:00:00 1970 +0000

+++ b/SCPTester.dsc Wed Jan 30 03:08:38 2019 +0300

		@@ -0,0 +1,52 @@
	1	+#----------------------------------------------------------------------------#
	2	+# Copyright 2019 Levashev Ivan Aleksandrovich #
	3	+# #
	4	+# Licensed under the Apache License, Version 2.0 (the "License"); #
	5	+# you may not use this file except in compliance with the License. #
	6	+# You may obtain a copy of the License at #
	7	+# #
	8	+# http://www.apache.org/licenses/LICENSE-2.0 #
	9	+# #
	10	+# Unless required by applicable law or agreed to in writing, software #
	11	+# distributed under the License is distributed on an "AS IS" BASIS, #
	12	+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. #
	13	+# See the License for the specific language governing permissions and #
	14	+# limitations under the License. #
	15	+#----------------------------------------------------------------------------#
	16	+
	17	+#DEFINE COMMAND, OLE
	18	+#DEFINE FUNCTION, OLE
	19	+EXTERNAL VDSOLEAUT.DLL,ignored
	20	+
	21	+%%sessionOptions = @OLE(variant, WinSCP.SessionOptions, THREADEDOBJECT)
	22	+OLE MODIFY, variant, %%sessionOptions, PUT, Protocol, 0, INTEGER
	23	+OLE MODIFY, variant, %%sessionOptions, PUT, HostName, 173.249.20.221, STRING
	24	+OLE MODIFY, variant, %%sessionOptions, PUT, PortNumber, 8022, INTEGER
	25	+OLE MODIFY, variant, %%sessionOptions, PUT, UserName, root, STRING
	26	+OLE MODIFY, variant, %%sessionOptions, PUT, SshPrivateKeyPath, C:\home\OCTAGRAM\Linux\main.ppk, STRING
	27	+OLE MODIFY, variant, %%sessionOptions, PUT, SshHostKeyFingerprint, ssh-ed25519 256 43:3d:7a:b9:ef:f4:c6:81:9c:51:4c:26:3e:fa:d1:50, STRING
	28	+
	29	+%%session = @OLE(variant, WinSCP.Session, THREADEDOBJECT)
	30	+
	31	+# Connect
	32	+OLE INVOKE, variant, %%session, DO, Open, %%sessionOptions, VARIANT
	33	+OLE CLOSE, variant, %%sessionOptions
	34	+
	35	+%%directory = @OLE(variant, %%session, GET, variant, ListDirectory, /opt/aws, STRING)
	36	+%%files = @OLE(variant, %%directory, GET, enumerator, Files)
	37	+
	38	+%%fileInfo = @OLE(enumerator, %%files, NEXT)
	39	+WHILE %%fileInfo
	40	+ %%fileListAsString = %%fileListAsString@CHR(13)@CHR(10)@OLE(variant, %%fileInfo, GET, string, Name) with size @OLE(variant, %%fileInfo, GET, string, Length)
	41	+
	42	+ OLE CLOSE, variant, %%fileInfo
	43	+ %%fileInfo = @OLE(enumerator, %%files, NEXT)
	44	+WEND
	45	+OLE CLOSE, enumerator, %%files
	46	+
	47	+INFO %%fileListAsString
	48	+
	49	+# Disconnect, clean up
	50	+OLE INVOKE, variant, %%session, DO, Dispose
	51	+
	52	+OLE CLOSE, variant, %%session

diff -r 000000000000 -r 7b0b6c9522b8 SCPTester.dsp

--- /dev/null Thu Jan 01 00:00:00 1970 +0000

+++ b/SCPTester.dsp Wed Jan 30 03:08:38 2019 +0300

		@@ -0,0 +1,3 @@
	1	+[Syntax]
	2	+Commands=OLE
	3	+Functions=@OLE

diff -r 000000000000 -r 7b0b6c9522b8 oletester.dsc

--- /dev/null Thu Jan 01 00:00:00 1970 +0000

+++ b/oletester.dsc Wed Jan 30 03:08:38 2019 +0300

		@@ -0,0 +1,84 @@
	1	+#----------------------------------------------------------------------------#
	2	+# Copyright 2019 Levashev Ivan Aleksandrovich #
	3	+# #
	4	+# Licensed under the Apache License, Version 2.0 (the "License"); #
	5	+# you may not use this file except in compliance with the License. #
	6	+# You may obtain a copy of the License at #
	7	+# #
	8	+# http://www.apache.org/licenses/LICENSE-2.0 #
	9	+# #
	10	+# Unless required by applicable law or agreed to in writing, software #
	11	+# distributed under the License is distributed on an "AS IS" BASIS, #
	12	+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. #
	13	+# See the License for the specific language governing permissions and #
	14	+# limitations under the License. #
	15	+#----------------------------------------------------------------------------#
	16	+
	17	+#DEFINE COMMAND, OLE
	18	+#DEFINE FUNCTION, OLE
	19	+EXTERNAL VDSOLEAUT.DLL,ignored
	20	+
	21	+%S = @OLE(variant, SAPI.SpVoice, THREADEDOBJECT)
	22	+
	23	+INFO SAPI.SpVoice created with type @OLE(variant, %S, TYPEOF)
	24	+# OBJECT if Speech API is installed
	25	+
	26	+OLE INVOKE, variant, %S, DO, Speak, This is a test, STRING
	27	+# Speak text synchronously with default voice
	28	+
	29	+%P = @OLE(variant, %S, DO, promise, Speak, This is another test. You should hear speech and see message at the same time, STRING)
	30	+# Speak text asynchronously with default voice
	31	+
	32	+INFO Asynchronous method invocation
	33	+# One should see this message in parallel with actual voice
	34	+
	35	+WHILE @OLE(promise, %P, ISRUNNING)
	36	+ # WAIT EVENT
	37	+ # Only valid when dialog is displayed
	38	+
	39	+ WAIT 1
	40	+ # UI is responding while background thread executes
	41	+WEND
	42	+
	43	+OLE CLOSE, promise, %P
	44	+
	45	+INFO Volume property by default: @OLE(variant, %S, GET, string, Volume)
	46	+# 100 by default
	47	+
	48	+OLE MODIFY, variant, %S, PUT, Volume, 80, INTEGER
	49	+# Set volume to 80
	50	+
	51	+INFO Volume property after synchronous modification: @OLE(variant, %S, GET, string, Volume)
	52	+# Now it is 80
	53	+
	54	+%P = @OLE(variant, %S, PUT, promise, Volume, 100, INTEGER)
	55	+# Asynchronous property modification
	56	+
	57	+INFO Volume property after asynchronous modification: @OLE(variant, %S, GET, string, Volume)
	58	+# Can be still 80 if background thread starts slow (didn't manage to get this)
	59	+# Changes to 100 if THREADEDOBJECT changed to OBJECT in the beginning
	60	+
	61	+WHILE @OLE(promise, %P, ISRUNNING)
	62	+ WAIT 1
	63	+ # UI is responding while background thread executes
	64	+WEND
	65	+
	66	+INFO Volume property after waiting for completion: @OLE(variant, %S, GET, string, Volume)
	67	+
	68	+OLE CLOSE, promise, %P
	69	+
	70	+%V = @OLE(variant, %S, DO, variant, GetVoices)
	71	+%E = @OLE(variant, %V, ENUMERATE)
	72	+OLE CLOSE, variant, %V
	73	+
	74	+%V = @OLE(enumerator, %E, NEXT)
	75	+WHILE %V
	76	+ INFO Voice detected: @OLE(variant, %V, DO, string, GetDescription)
	77	+
	78	+ OLE CLOSE, variant, %V
	79	+ %V = @OLE(enumerator, %E, NEXT)
	80	+WEND
	81	+
	82	+OLE CLOSE, enumerator, %E
	83	+
	84	+OLE CLOSE, variant, %S

diff -r 000000000000 -r 7b0b6c9522b8 oletester.dsp

--- /dev/null Thu Jan 01 00:00:00 1970 +0000

+++ b/oletester.dsp Wed Jan 30 03:08:38 2019 +0300

		@@ -0,0 +1,35 @@
	1	+[Syntax]
	2	+Commands=OLE,OLEASYNC
	3	+Functions=@OLE,@OLEASYNC
	4	+[Project]
	5	+Main File=#oletester.dsc
	6	+tl_Main File=0
	7	+DS Version=5.0
	8	+Other File 1=
	9	+[BM_oletester]
	10	+BM0=
	11	+BM1=
	12	+BM2=
	13	+BM3=
	14	+BM4=
	15	+BM5=
	16	+BM6=
	17	+BM7=
	18	+BM8=
	19	+BM9=
	20	+[BP_oletester]
	21	+BP0=
	22	+BP1=
	23	+BP2=
	24	+BP3=
	25	+BP4=
	26	+BP5=
	27	+BP6=
	28	+BP7=
	29	+BP8=
	30	+BP9=
	31	+[Compiler]
	32	+InfoVersion=0
	33	+Include Manifest=1
	34	+[WatchList]
	35	+Watch 0=

diff -r 000000000000 -r 7b0b6c9522b8 vdsoleaut.Impl.pas

--- /dev/null Thu Jan 01 00:00:00 1970 +0000

+++ b/vdsoleaut.Impl.pas Wed Jan 30 03:08:38 2019 +0300

		@@ -0,0 +1,1293 @@
	1	+(****************************************************************************\
	2	+ Copyright 2019 Levashev Ivan Aleksandrovich
	3	+
	4	+ Licensed under the Apache License, Version 2.0 (the "License");
	5	+ you may not use this file except in compliance with the License.
	6	+ You may obtain a copy of the License at
	7	+
	8	+ http://www.apache.org/licenses/LICENSE-2.0
	9	+
	10	+ Unless required by applicable law or agreed to in writing, software
	11	+ distributed under the License is distributed on an "AS IS" BASIS,
	12	+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
	13	+ See the License for the specific language governing permissions and
	14	+ limitations under the License.
	15	+\****************************************************************************)
	16	+
	17	+unit vdsoleaut.Impl;
	18	+
	19	+interface
	20	+
	21	+uses
	22	+ SysUtils, Types, Windows;
	23	+
	24	+const
	25	+ Max_Parameters = 6 + 2 * ({ComObj.MaxDispArgs} 64 + 1);
	26	+ { maximum number of params/args (user-definable) }
	27	+ { more than Max_Parameters are not visible }
	28	+
	29	+type
	30	+ TVDSExtEventProc = procedure(EventType: PAnsiChar); cdecl;
	31	+
	32	+ EVDSError = class(Exception)
	33	+ private
	34	+ FErrorCode: Integer;
	35	+ public
	36	+ property ErrorCode: Integer read FErrorCode;
	37	+ constructor Create(AErrorCode: Integer = 32);
	38	+ end;
	39	+
	40	+var
	41	+ EventProc: TVDSExtEventProc;
	42	+ WHandle: Windows.PHandle;
	43	+ WM_VDSOLEASYNC: Windows.UINT = 0;
	44	+
	45	+procedure MessageException(E: SysUtils.Exception);
	46	+function HLInit(const KeyString: AnsiString): AnsiString;
	47	+procedure HLCommandProc(const Params: Types.TStringDynArray);
	48	+function HLFunctionProc(const Args: Types.TStringDynArray): AnsiString;
	49	+
	50	+implementation
	51	+
	52	+uses
	53	+ Dialogs, Variants, ActiveX, ComObj, Classes, TypInfo,
	54	+ vdsoleaut.Promises;
	55	+
	56	+// --------------------- BEGIN Utility
	57	+
	58	+constructor EVDSError.Create(AErrorCode: Integer = 32);
	59	+begin
	60	+ FErrorCode := AErrorCode;
	61	+ inherited Create('VDS error #' + SysUtils.IntToStr(AErrorCode));
	62	+end;
	63	+
	64	+var
	65	+ AllocatedOleVariants: array of OleVariant;
	66	+ AllocatedOleEnumerators: array of ActiveX.IEnumVARIANT;
	67	+
	68	+function AllocateOleVariant(const Item: OleVariant): AnsiString;
	69	+var
	70	+ L: Integer;
	71	+begin
	72	+ L := Length(AllocatedOleVariants);
	73	+ SetLength(AllocatedOleVariants, L + 1);
	74	+ AllocatedOleVariants[L] := Item;
	75	+ Result := IntToStr(L + 1);
	76	+end;
	77	+
	78	+function AllocateOleEnumerator(const Item: ActiveX.IEnumVARIANT): AnsiString;
	79	+var
	80	+ L: Integer;
	81	+begin
	82	+ L := Length(AllocatedOleEnumerators);
	83	+ SetLength(AllocatedOleEnumerators, L + 1);
	84	+ AllocatedOleEnumerators[L] := Item;
	85	+ Result := IntToStr(L + 1);
	86	+end;
	87	+
	88	+function AllocatedOleVariant(Index: Integer): OleVariant;
	89	+begin
	90	+ if (Index < 1) or (Index > Length(AllocatedOleVariants)) then
	91	+ begin
	92	+ Result := Variants.Unassigned;
	93	+ Exit;
	94	+ end;
	95	+
	96	+ Result := AllocatedOleVariants[Index - 1];
	97	+end;
	98	+
	99	+function AllocatedOleEnumerator(Index: Integer): ActiveX.IEnumVARIANT;
	100	+begin
	101	+ if (Index < 1) or (Index > Length(AllocatedOleEnumerators)) then
	102	+ begin
	103	+ Result := nil;
	104	+ Exit;
	105	+ end;
	106	+
	107	+ Result := AllocatedOleEnumerators[Index - 1];
	108	+end;
	109	+
	110	+procedure DeallocateOleVariant(Index: Integer);
	111	+var
	112	+ L, I: Integer;
	113	+begin
	114	+ if (Index < 1) or (Index > Length(AllocatedOleVariants)) then
	115	+ begin
	116	+ Exit;
	117	+ end;
	118	+
	119	+ System.VarClear(AllocatedOleVariants[Index - 1]);
	120	+ L := Length(AllocatedOleVariants);
	121	+ for I := L - 1 downto 0 do
	122	+ begin
	123	+ if not Variants.VarIsEmpty(AllocatedOleVariants[I]) then
	124	+ begin
	125	+ if I <> L - 1 then
	126	+ begin
	127	+ SetLength(AllocatedOleVariants, I + 1);
	128	+ end;
	129	+
	130	+ Exit;
	131	+ end;
	132	+ end;
	133	+
	134	+ AllocatedOleVariants := nil;
	135	+end;
	136	+
	137	+procedure DeallocateOleEnumerator(Index: Integer);
	138	+var
	139	+ L, I: Integer;
	140	+begin
	141	+ if (Index < 1) or (Index > Length(AllocatedOleEnumerators)) then
	142	+ begin
	143	+ Exit;
	144	+ end;
	145	+
	146	+ AllocatedOleEnumerators[Index - 1] := nil;
	147	+ L := Length(AllocatedOleEnumerators);
	148	+ for I := L - 1 downto 0 do
	149	+ begin
	150	+ if Assigned(AllocatedOleEnumerators[I]) then
	151	+ begin
	152	+ if I <> L - 1 then
	153	+ begin
	154	+ SetLength(AllocatedOleEnumerators, I + 1);
	155	+ end;
	156	+
	157	+ Exit;
	158	+ end;
	159	+ end;
	160	+
	161	+ AllocatedOleEnumerators := nil;
	162	+end;
	163	+
	164	+procedure DeallocateOleVariants;
	165	+begin
	166	+ AllocatedOleVariants := nil;
	167	+end;
	168	+
	169	+procedure DeallocateOleEnumerators;
	170	+begin
	171	+ AllocatedOleEnumerators := nil;
	172	+end;
	173	+
	174	+var
	175	+ FormatSettings: SysUtils.TFormatSettings;
	176	+
	177	+type
	178	+ PIStream = ^ActiveX.IStream;
	179	+ TMtaOleObjectCreator = class(Classes.TThread)
	180	+ private
	181	+ FName: WideString;
	182	+ FResultAsIStream: PIStream;
	183	+ protected
	184	+ procedure Execute; override;
	185	+ public
	186	+ constructor Create(const AName: WideString; AResultAsIStream: PIStream);
	187	+ end;
	188	+
	189	+constructor TMtaOleObjectCreator.Create(const AName: WideString; AResultAsIStream: PIStream);
	190	+begin
	191	+ inherited Create(True);
	192	+ FName := AName;
	193	+ FResultAsIStream := AResultAsIStream;
	194	+ Resume;
	195	+end;
	196	+
	197	+procedure TMtaOleObjectCreator.Execute;
	198	+var
	199	+ ResultAsIDispatch: IDispatch;
	200	+begin
	201	+ ComObj.OleCheck(ActiveX.CoInitializeEx(nil, ActiveX.COINIT_MULTITHREADED));
	202	+ try
	203	+ ResultAsIDispatch := ComObj.CreateOleObject(FName);
	204	+ ComObj.OleCheck(ActiveX.CoMarshalInterThreadInterfaceInStream(IDispatch, ResultAsIDispatch, FResultAsIStream^));
	205	+ except
	206	+ on E: SysUtils.Exception do
	207	+ begin
	208	+ MessageException(E);
	209	+ end;
	210	+ end;
	211	+ ActiveX.CoUninitialize;
	212	+end;
	213	+
	214	+function CreateMtaOleObject(const Name: WideString): IDispatch;
	215	+var
	216	+ Creator: TMtaOleObjectCreator;
	217	+ ResultAsIStream: ActiveX.IStream;
	218	+begin
	219	+ Creator := TMtaOleObjectCreator.Create(Name, @ResultAsIStream);
	220	+ try
	221	+ Creator.WaitFor;
	222	+
	223	+ if not Assigned(ResultAsIStream) then
	224	+ begin
	225	+ raise EVDSError.Create;
	226	+ end;
	227	+
	228	+ ComObj.OleCheck(CoGetInterfaceAndReleaseStream(ResultAsIStream, IDispatch, Result));
	229	+ ResultAsIStream := nil;
	230	+ finally
	231	+ FreeAndNil(Creator);
	232	+ end;
	233	+end;
	234	+
	235	+function CreateOleVariant(const Value, Kind: AnsiString): OleVariant;
	236	+begin
	237	+ if Kind = 'STRING' then
	238	+ begin
	239	+ Result := WideString(Value);
	240	+ end
	241	+ else if Kind = 'UTF' then
	242	+ begin
	243	+ Result := UTF8Decode(Value);
	244	+ end
	245	+ else if Kind = 'INTEGER' then
	246	+ begin
	247	+ Result := StrToInt64(Value);
	248	+ end
	249	+ else if Kind = 'BOOLEAN' then
	250	+ begin
	251	+ if (Value = 'TRUE') or (Value = 'True') or (Value = 'true') then
	252	+ begin
	253	+ Result := True;
	254	+ end
	255	+ else if (Value = 'FALSE') or (Value = 'False') or (Value = 'false') then
	256	+ begin
	257	+ Result := False;
	258	+ end
	259	+ else
	260	+ begin
	261	+ raise EVDSError.Create;
	262	+ end;
	263	+ end
	264	+ else if Kind = 'REAL' then
	265	+ begin
	266	+ Result := StrToFloat(Value, FormatSettings);
	267	+ end
	268	+ else if (Kind = 'EMPTY') or (Kind = '') then
	269	+ begin
	270	+ Result := Variants.EmptyParam;
	271	+ end
	272	+ else if Kind = 'OBJECT' then
	273	+ begin
	274	+ Result := ComObj.CreateOleObject(WideString(Value));
	275	+ end
	276	+ else if Kind = 'THREADEDOBJECT' then
	277	+ begin
	278	+ Result := CreateMtaOleObject(WideString(Value));
	279	+ end
	280	+ else if Kind = 'VARIANT' then
	281	+ begin
	282	+ Result := AllocatedOleVariant(StrToInt(Value));
	283	+ end
	284	+ else
	285	+ begin
	286	+ raise EVDSError.Create;
	287	+ end;
	288	+end;
	289	+
	290	+type
	291	+ TStringArrayForSlice = array[0 .. MaxInt div SizeOf(string) - 1] of string;
	292	+ PStringArrayForSlice = ^TStringArrayForSlice;
	293	+
	294	+function BeginSlice(const DynArray: Types.TStringDynArray; Start: Integer): PStringArrayForSlice;
	295	+begin
	296	+ Result :=
	297	+ PStringArrayForSlice(PAnsiChar(Pointer(DynArray)) + Start * SizeOf(string));
	298	+end;
	299	+
	300	+// --------------------- END Utility
	301	+
	302	+var
	303	+ InitializedOle: Boolean = False;
	304	+
	305	+function HLInit(const KeyString: AnsiString): AnsiString;
	306	+begin
	307	+ DeallocateOleVariants;
	308	+ if not InitializedOle then
	309	+ begin
	310	+ ComObj.OleCheck(ActiveX.OleInitialize(nil));
	311	+ InitializedOle := True;
	312	+ end;
	313	+
	314	+ if WM_VDSOLEASYNC = 0 then
	315	+ begin
	316	+ WM_VDSOLEASYNC := Windows.RegisterWindowMessageW('WM_VDSOLEASYNC');
	317	+ if WM_VDSOLEASYNC = 0 then
	318	+ begin
	319	+ RaiseLastOSError;
	320	+ end;
	321	+ end;
	322	+
	323	+ Result := 'OLE\|OLEASYNC\|*' + IntToStr(WM_VDSOLEASYNC) + '.OLEASYNCEVENT!';
	324	+end;
	325	+
	326	+function HLTypeOf(const Item: OleVariant): AnsiString;
	327	+begin
	328	+ case Variants.VarType(Item) of
	329	+ varEmpty: Result := 'UNDEFINED';
	330	+ varNull: Result := 'NULL';
	331	+ varSmallInt, varInteger, varShortInt,
	332	+ varByte, varWord, varLongWord,
	333	+ varInt64, $0015: Result := 'INTEGER';
	334	+ varSingle, varDouble, varCurrency: Result := 'REAL';
	335	+ varDate: Result := 'DATETIME';
	336	+ varOleStr: Result := 'STRING';
	337	+ varDispatch: Result := 'OBJECT';
	338	+ varBoolean: Result := 'BOOLEAN';
	339	+ else
	340	+ Result := 'UNKNOWN';
	341	+ end;
	342	+end;
	343	+
	344	+function HLToString(const Item: OleVariant; Ansi: Boolean): AnsiString;
	345	+begin
	346	+ case Variants.VarType(Item) of
	347	+ varEmpty: Result := 'UNDEFINED';
	348	+ varNull: Result := 'NULL';
	349	+ varSmallInt, varInteger, varShortInt,
	350	+ varByte, varWord: Result := IntToStr(Integer(Item));
	351	+ varLongWord: Result := IntToStr(Int64(LongWord(Item)));
	352	+ varInt64, $0015: Result := IntToStr(System.TVarData(Item).VInt64);
	353	+ varSingle, varDouble: Result := FloatToStr(Double(Item), FormatSettings);
	354	+ varCurrency: Result := CurrToStr(System.TVarData(Item).VCurrency, FormatSettings);
	355	+ varDate: Result := DateTimeToStr(Variants.VarToDateTime(Item), FormatSettings);
	356	+ varOleStr:
	357	+ if Ansi then
	358	+ begin
	359	+ Result := AnsiString(WideString(Item));
	360	+ end
	361	+ else
	362	+ begin
	363	+ Result := UTF8Encode(WideString(Item));
	364	+ end;
	365	+ varDispatch: Result := 'OBJECT';
	366	+ varBoolean: Result := BoolToStr(Boolean(Item), True);
	367	+ else
	368	+ Result := 'UNKNOWN';
	369	+ end;
	370	+end;
	371	+
	372	+function HLEnumerate(const Item: OleVariant): ActiveX.IEnumVARIANT; forward;
	373	+
	374	+function ProduceResult(const Item: OleVariant; const Mode: AnsiString): AnsiString;
	375	+begin
	376	+ if Mode = 'variant' then
	377	+ begin
	378	+ Result := AllocateOleVariant(Item);
	379	+ Exit;
	380	+ end
	381	+ else if Mode = 'string' then
	382	+ begin
	383	+ Result := HLToString(Item, True);
	384	+ Exit;
	385	+ end
	386	+ else if Mode = 'utf' then
	387	+ begin
	388	+ Result := HLToString(Item, False);
	389	+ Exit;
	390	+ end
	391	+ else if Mode = 'enumerator' then
	392	+ begin
	393	+ Result := AllocateOleEnumerator(HLEnumerate(Item));
	394	+ Exit;
	395	+ end;
	396	+
	397	+ raise EVDSError.Create;
	398	+end;
	399	+
	400	+const
	401	+ IID_NULL: TGUID = '{00000000-0000-0000-0000-000000000000}';
	402	+
	403	+type
	404	+ TWideStringDynArray = array of WideString;
	405	+ // WideString is important (OLE), it's not UnicodeString
	406	+ TDispIDDynArray = array of ActiveX.TDispID;
	407	+ TOleVariantDynArray = array of OleVariant;
	408	+ TDispParamsHolder = record
	409	+ MethodID: ActiveX.TDispID;
	410	+ DispIDs: TDispIDDynArray;
	411	+ ParametersForInvoke: TOleVariantDynArray;
	412	+ DispParams: ActiveX.TDispParams;
	413	+ end;
	414	+
	415	+function PrepareInvoke(const Item: IDispatch; const MethodName: AnsiString;
	416	+ const Parameters: array of AnsiString;
	417	+ PutProperty: Boolean = False): TDispParamsHolder;
	418	+var
	419	+ Names: TWideStringDynArray;
	420	+ ParameterIndex: Integer;
	421	+ Kind: AnsiString;
	422	+ KindPos: Integer;
	423	+ PutPropertyShift: Integer;
	424	+begin
	425	+ SetLength(Names, 1);
	426	+ Names[0] := WideString(MethodName);
	427	+
	428	+ PutPropertyShift := 0;
	429	+ if PutProperty then
	430	+ begin
	431	+ PutPropertyShift := 1;
	432	+ end;
	433	+
	434	+ SetLength(Result.ParametersForInvoke, Length(Parameters) div 2);
	435	+ for ParameterIndex := 0 to Length(Result.ParametersForInvoke) - 1 - PutPropertyShift do
	436	+ begin
	437	+ Kind := Parameters[ParameterIndex * 2 + 1];
	438	+ KindPos := Pos(':', Kind);
	439	+ if KindPos = 0 then
	440	+ begin
	441	+ if Length(Names) > 1 then
	442	+ begin
	443	+ raise EVDSError.Create;
	444	+ // cannot have positional parameters after named ones
	445	+ end;
	446	+ end
	447	+ else
	448	+ begin
	449	+ if Length(Names) = 1 then
	450	+ begin
	451	+ SetLength(Names, Length(Result.ParametersForInvoke) + 1 - ParameterIndex - PutPropertyShift);
	452	+ end;
	453	+
	454	+ Names[Length(Result.ParametersForInvoke) - ParameterIndex - PutPropertyShift] :=
	455	+ WideString(Trim(Copy(Kind, 1, KindPos - 1)));
	456	+ Kind := Trim(Copy(Kind, KindPos + 1, Length(Kind) - KindPos));
	457	+ end;
	458	+
	459	+ Result.ParametersForInvoke
	460	+ [Length(Result.ParametersForInvoke) - ParameterIndex - 1] :=
	461	+ CreateOleVariant(Parameters[ParameterIndex * 2], Kind);
	462	+ end;
	463	+ Kind := '';
	464	+
	465	+ SetLength(Result.DispIDs, Length(Names));
	466	+ ComObj.OleCheck(IDispatch(Item).GetIDsOfNames
	467	+ (IID_NULL, @(Names[0]), Length(Names), ActiveX.STDOLE_LCID, @(Result.DispIDs[0])));
	468	+
	469	+ SetLength(Names, 0);
	470	+
	471	+ Result.MethodID := Result.DispIDs[0];
	472	+
	473	+ if PutProperty then
	474	+ begin
	475	+ Result.DispIDs[0] := ActiveX.DISPID_PROPERTYPUT;
	476	+ ParameterIndex := Length(Result.ParametersForInvoke) - 1;
	477	+ Result.ParametersForInvoke[0] := CreateOleVariant(Parameters[ParameterIndex * 2], Parameters[ParameterIndex * 2 + 1]);
	478	+ end;
	479	+
	480	+ if Length(Result.ParametersForInvoke) > 0 then
	481	+ begin
	482	+ Result.DispParams.rgvarg := Pointer(@(Result.ParametersForInvoke[0]));
	483	+ end
	484	+ else
	485	+ begin
	486	+ Result.DispParams.rgvarg := nil;
	487	+ end;
	488	+
	489	+ if Length(Result.DispIDs) > (1 - PutPropertyShift) then
	490	+ begin
	491	+ Result.DispParams.rgdispidNamedArgs := Pointer(@(Result.DispIDs[1 - PutPropertyShift]));
	492	+ end
	493	+ else
	494	+ begin
	495	+ Result.DispParams.rgdispidNamedArgs := nil;
	496	+ end;
	497	+
	498	+ Result.DispParams.cArgs := Length(Result.ParametersForInvoke);
	499	+ Result.DispParams.cNamedArgs := Length(Result.DispIDs) + PutPropertyShift - 1;
	500	+end;
	501	+
	502	+procedure DispatchCheck(Result: HResult; const ExcepInfo: ActiveX.TExcepInfo);
	503	+begin
	504	+ if not ActiveX.Succeeded(Result) then
	505	+ begin
	506	+ ComObj.DispatchInvokeError(Result, ExcepInfo);
	507	+ end;
	508	+end;
	509	+
	510	+procedure HLInvokeDo(const Item: OleVariant; Flags: Word;
	511	+ const MethodName: AnsiString;
	512	+ const Parameters: array of AnsiString);
	513	+var
	514	+ DispParamsHolder: TDispParamsHolder;
	515	+ ExcepInfo: ActiveX.TExcepInfo;
	516	+begin
	517	+ if not Variants.VarIsType(Item, varDispatch) then
	518	+ begin
	519	+ raise EVDSError.Create;
	520	+ end;
	521	+
	522	+ DispParamsHolder := PrepareInvoke(IDispatch(Item), MethodName, Parameters);
	523	+
	524	+ DispatchCheck(IDispatch(Item).Invoke
	525	+ (DispParamsHolder.MethodID, IID_NULL, ActiveX.STDOLE_LCID,
	526	+ Flags, DispParamsHolder.DispParams, nil, @ExcepInfo, nil), ExcepInfo);
	527	+end;
	528	+
	529	+function HLInvokeDoWithResult(const Item: OleVariant; Flags: Word;
	530	+ const MethodName: AnsiString;
	531	+ const Parameters: array of AnsiString): OleVariant;
	532	+var
	533	+ DispParamsHolder: TDispParamsHolder;
	534	+ ExcepInfo: ActiveX.TExcepInfo;
	535	+begin
	536	+ if not Variants.VarIsType(Item, varDispatch) then
	537	+ begin
	538	+ raise EVDSError.Create;
	539	+ end;
	540	+
	541	+ DispParamsHolder := PrepareInvoke(IDispatch(Item), MethodName, Parameters);
	542	+
	543	+ DispatchCheck(IDispatch(Item).Invoke
	544	+ (DispParamsHolder.MethodID, IID_NULL, ActiveX.STDOLE_LCID,
	545	+ Flags, DispParamsHolder.DispParams, @Result, @ExcepInfo, nil), ExcepInfo);
	546	+
	547	+ if Variants.VarIsByRef(Result) then
	548	+ begin
	549	+ case ActiveX.TVariantArg(Result).vt of
	550	+ ActiveX.VT_BYREF or ActiveX.VT_UI1: Result := ActiveX.TVariantArg(Result).pbVal^;
	551	+ ActiveX.VT_BYREF or ActiveX.VT_I2: Result := ActiveX.TVariantArg(Result).piVal^;
	552	+ ActiveX.VT_BYREF or ActiveX.VT_I4: Result := ActiveX.TVariantArg(Result).plVal^;
	553	+ ActiveX.VT_BYREF or ActiveX.VT_R4: Result := ActiveX.TVariantArg(Result).pfltVal^;
	554	+ ActiveX.VT_BYREF or ActiveX.VT_R8: Result := ActiveX.TVariantArg(Result).pdblVal^;
	555	+ ActiveX.VT_BYREF or ActiveX.VT_BOOL: Result := ActiveX.TVariantArg(Result).pbool^;
	556	+ ActiveX.VT_BYREF or ActiveX.VT_ERROR: Result := Variants.VarAsError(ActiveX.TVariantArg(Result).pscode^);
	557	+ ActiveX.VT_BYREF or ActiveX.VT_CY: Result := ActiveX.TVariantArg(Result).pcyVal^;
	558	+ ActiveX.VT_BYREF or ActiveX.VT_DATE: Result := Variants.VarFromDateTime(ActiveX.TVariantArg(Result).pdate^);
	559	+ ActiveX.VT_BYREF or ActiveX.VT_BSTR: Result := ActiveX.TVariantArg(Result).pbstrVal^;
	560	+ ActiveX.VT_BYREF or ActiveX.VT_UNKNOWN: Result := ActiveX.TVariantArg(Result).punkVal^;
	561	+ ActiveX.VT_BYREF or ActiveX.VT_DISPATCH: Result := ActiveX.TVariantArg(Result).pdispVal^;
	562	+ // ActiveX.VT_BYREF or ActiveX.VT_ARRAY: Result := ActiveX.TVariantArg(Result).pparray^;
	563	+ ActiveX.VT_BYREF or ActiveX.VT_VARIANT: Result := ActiveX.TVariantArg(Result).pvarVal^;
	564	+ // ActiveX.VT_BYREF or ActiveX.VT_DECIMAL: (pdecVal: PDecimal);
	565	+ ActiveX.VT_BYREF or ActiveX.VT_I1: Result := ShortInt(ActiveX.TVariantArg(Result).pcVal^);
	566	+ ActiveX.VT_BYREF or ActiveX.VT_UI2: Result := ActiveX.TVariantArg(Result).puiVal^;
	567	+ ActiveX.VT_BYREF or ActiveX.VT_UI4: Result := ActiveX.TVariantArg(Result).pulVal^;
	568	+ ActiveX.VT_BYREF or ActiveX.VT_INT: Result := ActiveX.TVariantArg(Result).pintVal^;
	569	+ ActiveX.VT_BYREF or ActiveX.VT_UINT: Result := ActiveX.TVariantArg(Result).puintVal^;
	570	+ else
	571	+ raise EVDSError.Create;
	572	+ end;
	573	+ end;
	574	+
	575	+ if Variants.VarIsArray(Result) then
	576	+ begin
	577	+ raise EVDSError.Create;
	578	+ end;
	579	+
	580	+ // TODO: arrays
	581	+ // TODO: try cast IUnknown to IDispatch?
	582	+end;
	583	+
	584	+procedure MessageException(E: SysUtils.Exception);
	585	+var
	586	+ TI: TypInfo.PTypeInfo;
	587	+begin
	588	+ TI := E.ClassInfo;
	589	+ if Assigned(TI) then
	590	+ begin
	591	+ Dialogs.MessageDlg(TypInfo.GetTypeData(TI).UnitName + '.' +
	592	+ E.ClassName + ': ' + E.Message, Dialogs.mtError, [Dialogs.mbOK], 0, Dialogs.mbOK);
	593	+ end
	594	+ else
	595	+ begin
	596	+ Dialogs.MessageDlg(E.ClassName + ': ' + E.Message, Dialogs.mtError, [Dialogs.mbOK], 0, Dialogs.mbOK);
	597	+ end;
	598	+end;
	599	+
	600	+type
	601	+ TIStreamDynArray = array of ActiveX.IStream;
	602	+ TMarshalOleVariantMode = (movmNone, movmIUnknown, movmIDispatch);
	603	+ TMarshalOleVariantDynArray = array of TMarshalOleVariantMode;
	604	+ TGenericInvokeThread = class(Classes.TThread)
	605	+ private
	606	+ FPromise: vdsoleaut.Promises.IAsyncCallPromise;
	607	+ FDispParamsHolder: TDispParamsHolder;
	608	+ FMarshalOleVariantModes: TMarshalOleVariantDynArray;
	609	+ FMarshalOleVariantStreams: TIStreamDynArray;
	610	+ FItemStream: ActiveX.IStream; // IDispatch;
	611	+ FFlags: Word;
	612	+ protected
	613	+ function GetItemOnce: IDispatch;
	614	+ procedure MarshalParams;
	615	+ procedure UnmarshalParams;
	616	+ public
	617	+ constructor Create
	618	+ (const APromise: vdsoleaut.Promises.IAsyncCallPromise;
	619	+ const ADispParamsHolder: TDispParamsHolder;
	620	+ const AItem: IDispatch;
	621	+ AFlags: Word);
	622	+ end;
	623	+
	624	+constructor TGenericInvokeThread.Create
	625	+ (const APromise: vdsoleaut.Promises.IAsyncCallPromise;
	626	+ const ADispParamsHolder: TDispParamsHolder;
	627	+ const AItem: IDispatch;
	628	+ AFlags: Word);
	629	+begin
	630	+ inherited Create(True);
	631	+ FPromise := APromise;
	632	+ FDispParamsHolder := ADispParamsHolder;
	633	+ // FItem := AItem;
	634	+ ComObj.OleCheck(ActiveX.CoMarshalInterThreadInterfaceInStream(IDispatch, AItem, FItemStream));
	635	+ MarshalParams;
	636	+ FFlags := AFlags;
	637	+ FreeOnTerminate := True;
	638	+ Resume;
	639	+end;
	640	+
	641	+function TGenericInvokeThread.GetItemOnce: IDispatch;
	642	+begin
	643	+ ComObj.OleCheck(CoGetInterfaceAndReleaseStream(FItemStream, IDispatch, Result));
	644	+ FItemStream := nil;
	645	+end;
	646	+
	647	+procedure TGenericInvokeThread.MarshalParams;
	648	+var
	649	+ I, L: Integer;
	650	+begin
	651	+ L := Length(FDispParamsHolder.ParametersForInvoke);
	652	+ SetLength(FMarshalOleVariantModes, L);
	653	+ SetLength(FMarshalOleVariantStreams, L);
	654	+ for I := 0 to L - 1 do
	655	+ begin
	656	+ case TVarData(FDispParamsHolder.ParametersForInvoke[I]).VType of
	657	+ varDispatch:
	658	+ begin
	659	+ FMarshalOleVariantModes[I] := movmIDispatch;
	660	+ ComObj.OleCheck(ActiveX.CoMarshalInterThreadInterfaceInStream(IDispatch, IDispatch(FDispParamsHolder.ParametersForInvoke[I]), FMarshalOleVariantStreams[I]));
	661	+ FDispParamsHolder.ParametersForInvoke[I] := Variants.Unassigned;
	662	+ end;
	663	+ varUnknown:
	664	+ begin
	665	+ FMarshalOleVariantModes[I] := movmIUnknown;
	666	+ ComObj.OleCheck(ActiveX.CoMarshalInterThreadInterfaceInStream(IUnknown, IUnknown(FDispParamsHolder.ParametersForInvoke[I]), FMarshalOleVariantStreams[I]));
	667	+ FDispParamsHolder.ParametersForInvoke[I] := Variants.Unassigned;
	668	+ end;
	669	+ else
	670	+ FMarshalOleVariantModes[I] := movmNone;
	671	+ end;
	672	+ end;
	673	+end;
	674	+
	675	+procedure TGenericInvokeThread.UnmarshalParams;
	676	+var
	677	+ I, L: Integer;
	678	+ TempD: IDispatch;
	679	+ TempU: IUnknown;
	680	+begin
	681	+ L := Length(FDispParamsHolder.ParametersForInvoke);
	682	+ for I := 0 to L - 1 do
	683	+ begin
	684	+ case FMarshalOleVariantModes[I] of
	685	+ movmIDispatch:
	686	+ begin
	687	+ ComObj.OleCheck(ActiveX.CoGetInterfaceAndReleaseStream(FMarshalOleVariantStreams[I], IDispatch, TempD));
	688	+ FDispParamsHolder.ParametersForInvoke[I] := TempD;
	689	+ TempD := nil;
	690	+ FMarshalOleVariantStreams[I] := nil;
	691	+ end;
	692	+ movmIUnknown:
	693	+ begin
	694	+ ComObj.OleCheck(ActiveX.CoGetInterfaceAndReleaseStream(FMarshalOleVariantStreams[I], IUnknown, TempU));
	695	+ FDispParamsHolder.ParametersForInvoke[I] := TempU;
	696	+ TempU := nil;
	697	+ FMarshalOleVariantStreams[I] := nil;
	698	+ end;
	699	+ movmNone: // nothing to do
	700	+ end;
	701	+ end;
	702	+ SetLength(FMarshalOleVariantModes, 0);
	703	+ SetLength(FMarshalOleVariantStreams, 0);
	704	+end;
	705	+
	706	+type
	707	+ TInvokeDoThread = class(TGenericInvokeThread)
	708	+ protected
	709	+ procedure Execute; override;
	710	+ end;
	711	+
	712	+procedure TInvokeDoThread.Execute;
	713	+var
	714	+ ResultAsVariant: OleVariant;
	715	+ ExcepInfo: ActiveX.TExcepInfo;
	716	+begin
	717	+ ComObj.OleCheck(ActiveX.CoInitializeEx(nil, ActiveX.COINIT_MULTITHREADED));
	718	+ try
	719	+ UnmarshalParams;
	720	+ DispatchCheck(GetItemOnce.Invoke
	721	+ (FDispParamsHolder.MethodID, IID_NULL, ActiveX.STDOLE_LCID,
	722	+ FFlags, FDispParamsHolder.DispParams, @ResultAsVariant, @ExcepInfo, nil), ExcepInfo);
	723	+
	724	+ if Variants.VarIsByRef(ResultAsVariant) then
	725	+ begin
	726	+ case ActiveX.TVariantArg(ResultAsVariant).vt of
	727	+ ActiveX.VT_BYREF or ActiveX.VT_UI1: ResultAsVariant := ActiveX.TVariantArg(ResultAsVariant).pbVal^;
	728	+ ActiveX.VT_BYREF or ActiveX.VT_I2: ResultAsVariant := ActiveX.TVariantArg(ResultAsVariant).piVal^;
	729	+ ActiveX.VT_BYREF or ActiveX.VT_I4: ResultAsVariant := ActiveX.TVariantArg(ResultAsVariant).plVal^;
	730	+ ActiveX.VT_BYREF or ActiveX.VT_R4: ResultAsVariant := ActiveX.TVariantArg(ResultAsVariant).pfltVal^;
	731	+ ActiveX.VT_BYREF or ActiveX.VT_R8: ResultAsVariant := ActiveX.TVariantArg(ResultAsVariant).pdblVal^;
	732	+ ActiveX.VT_BYREF or ActiveX.VT_BOOL: ResultAsVariant := ActiveX.TVariantArg(ResultAsVariant).pbool^;
	733	+ ActiveX.VT_BYREF or ActiveX.VT_ERROR: ResultAsVariant := Variants.VarAsError(ActiveX.TVariantArg(ResultAsVariant).pscode^);
	734	+ ActiveX.VT_BYREF or ActiveX.VT_CY: ResultAsVariant := ActiveX.TVariantArg(ResultAsVariant).pcyVal^;
	735	+ ActiveX.VT_BYREF or ActiveX.VT_DATE: ResultAsVariant := Variants.VarFromDateTime(ActiveX.TVariantArg(ResultAsVariant).pdate^);
	736	+ ActiveX.VT_BYREF or ActiveX.VT_BSTR: ResultAsVariant := ActiveX.TVariantArg(ResultAsVariant).pbstrVal^;
	737	+ ActiveX.VT_BYREF or ActiveX.VT_UNKNOWN: ResultAsVariant := ActiveX.TVariantArg(ResultAsVariant).punkVal^;
	738	+ ActiveX.VT_BYREF or ActiveX.VT_DISPATCH: ResultAsVariant := ActiveX.TVariantArg(ResultAsVariant).pdispVal^;
	739	+ // ActiveX.VT_BYREF or ActiveX.VT_ARRAY: ResultAsVariant := ActiveX.TVariantArg(ResultAsVariant).pparray^;
	740	+ ActiveX.VT_BYREF or ActiveX.VT_VARIANT: ResultAsVariant := ActiveX.TVariantArg(ResultAsVariant).pvarVal^;
	741	+ // ActiveX.VT_BYREF or ActiveX.VT_DECIMAL: (pdecVal: PDecimal);
	742	+ ActiveX.VT_BYREF or ActiveX.VT_I1: ResultAsVariant := ShortInt(ActiveX.TVariantArg(ResultAsVariant).pcVal^);
	743	+ ActiveX.VT_BYREF or ActiveX.VT_UI2: ResultAsVariant := ActiveX.TVariantArg(ResultAsVariant).puiVal^;
	744	+ ActiveX.VT_BYREF or ActiveX.VT_UI4: ResultAsVariant := ActiveX.TVariantArg(ResultAsVariant).pulVal^;
	745	+ ActiveX.VT_BYREF or ActiveX.VT_INT: ResultAsVariant := ActiveX.TVariantArg(ResultAsVariant).pintVal^;
	746	+ ActiveX.VT_BYREF or ActiveX.VT_UINT: ResultAsVariant := ActiveX.TVariantArg(ResultAsVariant).puintVal^;
	747	+ else
	748	+ raise EVDSError.Create;
	749	+ end;
	750	+ end;
	751	+
	752	+ if Variants.VarIsArray(ResultAsVariant) then
	753	+ begin
	754	+ raise EVDSError.Create;
	755	+ end;
	756	+
	757	+ // TODO: arrays
	758	+ // TODO: try cast IUnknown to IDispatch?
	759	+ except
	760	+ on E: SysUtils.Exception do
	761	+ begin
	762	+ MessageException(E);
	763	+ end;
	764	+ end;
	765	+ FPromise.PostValue(ResultAsVariant);
	766	+ ActiveX.CoUninitialize;
	767	+end;
	768	+
	769	+function HLInvokeDoWithResultAsync(const Item: OleVariant; Flags: Word;
	770	+ const MethodName: AnsiString;
	771	+ const Parameters: array of AnsiString):
	772	+ vdsoleaut.Promises.IAsyncCallPromise;
	773	+var
	774	+ DispParamsHolder: TDispParamsHolder;
	775	+begin
	776	+ if not Variants.VarIsType(Item, varDispatch) then
	777	+ begin
	778	+ raise EVDSError.Create;
	779	+ end;
	780	+
	781	+ DispParamsHolder := PrepareInvoke(IDispatch(Item), MethodName, Parameters);
	782	+ Result := vdsoleaut.Promises.AllocatePromise;
	783	+ TInvokeDoThread.Create(Result, DispParamsHolder, IDispatch(Item), Flags);
	784	+end;
	785	+
	786	+procedure HLPutProperty(const Item: OleVariant; Flags: Word;
	787	+ const MethodName: AnsiString;
	788	+ const Parameters: array of AnsiString);
	789	+var
	790	+ DispParamsHolder: TDispParamsHolder;
	791	+ ExcepInfo: ActiveX.TExcepInfo;
	792	+begin
	793	+ if not Variants.VarIsType(Item, varDispatch) then
	794	+ begin
	795	+ raise EVDSError.Create;
	796	+ end;
	797	+
	798	+ DispParamsHolder := PrepareInvoke(IDispatch(Item), MethodName, Parameters, True);
	799	+
	800	+ DispatchCheck(IDispatch(Item).Invoke
	801	+ (DispParamsHolder.MethodID, IID_NULL, ActiveX.STDOLE_LCID,
	802	+ Flags, DispParamsHolder.DispParams, nil, @ExcepInfo, nil), ExcepInfo);
	803	+end;
	804	+
	805	+type
	806	+ TPutPropertyThread = class(TGenericInvokeThread)
	807	+ protected
	808	+ procedure Execute; override;
	809	+ end;
	810	+
	811	+procedure TPutPropertyThread.Execute;
	812	+var
	813	+ ExcepInfo: ActiveX.TExcepInfo;
	814	+begin
	815	+ ComObj.OleCheck(ActiveX.CoInitializeEx(nil, ActiveX.COINIT_MULTITHREADED));
	816	+ try
	817	+ UnmarshalParams;
	818	+ DispatchCheck(GetItemOnce.Invoke
	819	+ (FDispParamsHolder.MethodID, IID_NULL, ActiveX.STDOLE_LCID,
	820	+ FFlags, FDispParamsHolder.DispParams, nil, @ExcepInfo, nil), ExcepInfo);
	821	+ except
	822	+ on E: SysUtils.Exception do
	823	+ begin
	824	+ MessageException(E);
	825	+ end;
	826	+ end;
	827	+ FPromise.PostValue(Variants.Unassigned);
	828	+ ActiveX.CoUninitialize;
	829	+end;
	830	+
	831	+function HLPutPropertyAsync(const Item: OleVariant; Flags: Word;
	832	+ const MethodName: AnsiString;
	833	+ const Parameters: array of AnsiString):
	834	+ vdsoleaut.Promises.IAsyncCallPromise;
	835	+var
	836	+ DispParamsHolder: TDispParamsHolder;
	837	+begin
	838	+ if not Variants.VarIsType(Item, varDispatch) then
	839	+ begin
	840	+ raise EVDSError.Create;
	841	+ end;
	842	+
	843	+ DispParamsHolder := PrepareInvoke(IDispatch(Item), MethodName, Parameters, True);
	844	+
	845	+ Result := vdsoleaut.Promises.AllocatePromise;
	846	+ TPutPropertyThread.Create(Result, DispParamsHolder, IDispatch(Item), Flags);
	847	+end;
	848	+
	849	+function HLEnumerate(const Item: OleVariant): ActiveX.IEnumVARIANT;
	850	+var
	851	+ ExcepInfo: ActiveX.TExcepInfo;
	852	+ ResultAsVariant: OleVariant;
	853	+ DispParams: ActiveX.TDispParams;
	854	+begin
	855	+ if not Variants.VarIsType(Item, varDispatch) then
	856	+ begin
	857	+ raise EVDSError.Create;
	858	+ end;
	859	+
	860	+ DispParams.rgvarg := nil;
	861	+ DispParams.rgdispidNamedArgs := nil;
	862	+ DispParams.cArgs := 0;
	863	+ DispParams.cNamedArgs := 0;
	864	+
	865	+ DispatchCheck(IDispatch(Item).Invoke
	866	+ (ActiveX.DISPID_NEWENUM, IID_NULL, ActiveX.STDOLE_LCID,
	867	+ ActiveX.DISPATCH_PROPERTYGET, DispParams, @ResultAsVariant, @ExcepInfo, nil), ExcepInfo);
	868	+
	869	+ Result := IUnknown(ResultAsVariant) as ActiveX.IEnumVARIANT;
	870	+end;
	871	+
	872	+function HLNext(const Item: ActiveX.IEnumVARIANT): AnsiString;
	873	+var
	874	+ Status: HRESULT;
	875	+ Fetched: LongWord;
	876	+ ResultAsVariant: OleVariant;
	877	+begin
	878	+ if not Assigned(Item) then
	879	+ begin
	880	+ raise EVDSError.Create;
	881	+ end;
	882	+
	883	+ Status := Item.Next(1, ResultAsVariant, Fetched);
	884	+ if Status = S_FALSE then
	885	+ begin
	886	+ Result := '';
	887	+ Exit;
	888	+ end;
	889	+
	890	+ ComObj.OleCheck(Status);
	891	+
	892	+ if Fetched < 1 then
	893	+ begin
	894	+ Result := '';
	895	+ Exit;
	896	+ end
	897	+ else
	898	+ begin
	899	+ Result := AllocateOleVariant(ResultAsVariant);
	900	+ Exit;
	901	+ end;
	902	+end;
	903	+
	904	+function HLIsCompleted(const Item: vdsoleaut.Promises.IAsyncCallPromise): AnsiString;
	905	+begin
	906	+ if not Assigned(Item) then
	907	+ begin
	908	+ raise EVDSError.Create;
	909	+ end;
	910	+
	911	+ if Item.IsCompleted then
	912	+ begin
	913	+ Result := 'TRUE'
	914	+ end
	915	+ else
	916	+ begin
	917	+ Result := ''
	918	+ end;
	919	+end;
	920	+
	921	+function HLIsRunning(const Item: vdsoleaut.Promises.IAsyncCallPromise): AnsiString;
	922	+begin
	923	+ if not Assigned(Item) then
	924	+ begin
	925	+ raise EVDSError.Create;
	926	+ end;
	927	+
	928	+ if not Item.IsCompleted then
	929	+ begin
	930	+ Result := 'TRUE'
	931	+ end
	932	+ else
	933	+ begin
	934	+ Result := ''
	935	+ end;
	936	+end;
	937	+
	938	+function HLPromiseValue(const Item: vdsoleaut.Promises.IAsyncCallPromise): OleVariant;
	939	+begin
	940	+ if not Assigned(Item) then
	941	+ begin
	942	+ raise EVDSError.Create;
	943	+ end;
	944	+
	945	+ if not Item.IsCompleted then
	946	+ begin
	947	+ raise EVDSError.Create;
	948	+ end
	949	+ else
	950	+ begin
	951	+ Result := Item.Value;
	952	+ end;
	953	+end;
	954	+
	955	+// ---------------------------------------
	956	+
	957	+procedure HLCommandProc(const Params: Types.TStringDynArray);
	958	+begin
	959	+ if Length(Params) < 1 then
	960	+ begin
	961	+ raise EVDSError.Create;
	962	+ end;
	963	+
	964	+ if Params[0] = 'OLE' then
	965	+ begin
	966	+ if Length(Params) < 2 then
	967	+ begin
	968	+ raise EVDSError.Create;
	969	+ end;
	970	+
	971	+ if Params[1] = 'CLOSE' then
	972	+ begin
	973	+ if Length(Params) < 3 then
	974	+ begin
	975	+ raise EVDSError.Create;
	976	+ end;
	977	+
	978	+ if Params[2] = 'variant' then
	979	+ begin
	980	+ if Length(Params) < 4 then
	981	+ begin
	982	+ raise EVDSError.Create;
	983	+ end;
	984	+
	985	+ if Params[3] = 'ALL' then
	986	+ begin
	987	+ DeallocateOleVariants;
	988	+ Exit;
	989	+ end
	990	+ else
	991	+ begin
	992	+ DeallocateOleVariant(StrToInt(Params[3]));
	993	+ Exit;
	994	+ end;
	995	+ end
	996	+ else
	997	+ if Params[2] = 'enumerator' then
	998	+ begin
	999	+ if Length(Params) < 4 then
	1000	+ begin
	1001	+ raise EVDSError.Create;
	1002	+ end;
	1003	+
	1004	+ if Params[3] = 'ALL' then
	1005	+ begin
	1006	+ DeallocateOleEnumerators;
	1007	+ Exit;
	1008	+ end
	1009	+ else
	1010	+ begin
	1011	+ DeallocateOleEnumerator(StrToInt(Params[3]));
	1012	+ Exit;
	1013	+ end;
	1014	+ end
	1015	+ else
	1016	+ if Params[2] = 'promise' then
	1017	+ begin
	1018	+ if Length(Params) < 4 then
	1019	+ begin
	1020	+ raise EVDSError.Create;
	1021	+ end;
	1022	+
	1023	+ if Params[3] = 'ALL' then
	1024	+ begin
	1025	+ vdsoleaut.Promises.DeallocatePromises;
	1026	+ Exit;
	1027	+ end
	1028	+ else
	1029	+ begin
	1030	+ vdsoleaut.Promises.DeallocatePromise(StrToInt(Params[3]));
	1031	+ Exit;
	1032	+ end;
	1033	+ end
	1034	+ else
	1035	+ begin
	1036	+ raise EVDSError.Create;
	1037	+ end;
	1038	+ end
	1039	+ else if Params[1] = 'INVOKE' then
	1040	+ begin
	1041	+ if Length(Params) < 3 then
	1042	+ begin
	1043	+ raise EVDSError.Create;
	1044	+ end;
	1045	+
	1046	+ if Params[2] = 'variant' then
	1047	+ begin
	1048	+ if Length(Params) < 5 then
	1049	+ begin
	1050	+ raise EVDSError.Create;
	1051	+ end;
	1052	+
	1053	+ if Params[4] = 'DO' then
	1054	+ begin
	1055	+ if Length(Params) < 6 then
	1056	+ begin
	1057	+ raise EVDSError.Create;
	1058	+ end;
	1059	+
	1060	+ HLInvokeDo(AllocatedOleVariant(StrToInt(Params[3])),
	1061	+ ActiveX.DISPATCH_METHOD, Params[5],
	1062	+ Slice(BeginSlice(Params, 6)^, Length(Params) - 6));
	1063	+ Exit;
	1064	+ end
	1065	+ else
	1066	+ begin
	1067	+ raise EVDSError.Create;
	1068	+ end;
	1069	+ end
	1070	+ else
	1071	+ begin
	1072	+ raise EVDSError.Create;
	1073	+ end;
	1074	+ end else
	1075	+ if Params[1] = 'MODIFY' then
	1076	+ begin
	1077	+ if Length(Params) < 6 + 2 then
	1078	+ begin
	1079	+ raise EVDSError.Create;
	1080	+ end;
	1081	+
	1082	+ if (Params[2] = 'variant') and (Params[4] = 'PUT') then
	1083	+ begin
	1084	+ HLPutProperty(AllocatedOleVariant(StrToInt(Params[3])),
	1085	+ ActiveX.DISPATCH_PROPERTYPUT, Params[5],
	1086	+ Slice(BeginSlice(Params, 6)^, Length(Params) - 6));
	1087	+ Exit;
	1088	+ end;
	1089	+
	1090	+ raise EVDSError.Create;
	1091	+ end else
	1092	+ begin
	1093	+ raise EVDSError.Create;
	1094	+ end;
	1095	+ end
	1096	+ else
	1097	+ begin
	1098	+ raise EVDSError.Create;
	1099	+ end;
	1100	+
	1101	+ raise EVDSError.Create;
	1102	+end;
	1103	+
	1104	+function HLFunctionProc(const Args: Types.TStringDynArray): AnsiString;
	1105	+begin
	1106	+ if Length(Args) < 1 then
	1107	+ begin
	1108	+ raise EVDSError.Create;
	1109	+ end;
	1110	+
	1111	+ if Args[0] = 'OLE' then
	1112	+ begin
	1113	+ if Length(Args) < 2 then
	1114	+ begin
	1115	+ raise EVDSError.Create;
	1116	+ end;
	1117	+
	1118	+ if Args[1] = 'variant' then
	1119	+ begin
	1120	+ if Length(Args) < 4 then
	1121	+ begin
	1122	+ raise EVDSError.Create;
	1123	+ end;
	1124	+
	1125	+ if Args[3] = 'TYPEOF' then
	1126	+ begin
	1127	+ Result := HLTypeOf(AllocatedOleVariant(StrToInt(Args[2])));
	1128	+ Exit;
	1129	+ end
	1130	+ else if Args[3] = 'TOUTF' then
	1131	+ begin
	1132	+ Result := HLToString(AllocatedOleVariant(StrToInt(Args[2])), False);
	1133	+ Exit;
	1134	+ end
	1135	+ else if Args[3] = 'TOSTRING' then
	1136	+ begin
	1137	+ Result := HLToString(AllocatedOleVariant(StrToInt(Args[2])), True);
	1138	+ Exit;
	1139	+ end
	1140	+ else if Args[3] = 'DO' then
	1141	+ begin
	1142	+ if Length(Args) < 6 then
	1143	+ begin
	1144	+ raise EVDSError.Create;
	1145	+ end;
	1146	+
	1147	+ if Args[4] = 'promise' then
	1148	+ begin
	1149	+ Result := IntToStr(HLInvokeDoWithResultAsync(AllocatedOleVariant
	1150	+ (StrToInt(Args[2])), ActiveX.DISPATCH_METHOD, Args[5],
	1151	+ Slice(BeginSlice(Args, 6)^, Length(Args) - 6)).Index);
	1152	+ Exit;
	1153	+ end
	1154	+ else
	1155	+ begin
	1156	+ Result := ProduceResult(HLInvokeDoWithResult(AllocatedOleVariant
	1157	+ (StrToInt(Args[2])), ActiveX.DISPATCH_METHOD, Args[5],
	1158	+ Slice(BeginSlice(Args, 6)^, Length(Args) - 6)), Args[4]);
	1159	+ Exit;
	1160	+ end;
	1161	+ end
	1162	+ else if Args[3] = 'GET' then
	1163	+ begin
	1164	+ if Length(Args) < 6 then
	1165	+ begin
	1166	+ raise EVDSError.Create;
	1167	+ end;
	1168	+
	1169	+ if Args[4] = 'promise' then
	1170	+ begin
	1171	+ Result := IntToStr(HLInvokeDoWithResultAsync(AllocatedOleVariant
	1172	+ (StrToInt(Args[2])), ActiveX.DISPATCH_PROPERTYGET, Args[5],
	1173	+ Slice(BeginSlice(Args, 6)^, Length(Args) - 6)).Index);
	1174	+ Exit;
	1175	+ end
	1176	+ else
	1177	+ begin
	1178	+ Result := ProduceResult(HLInvokeDoWithResult(AllocatedOleVariant
	1179	+ (StrToInt(Args[2])), ActiveX.DISPATCH_PROPERTYGET, Args[5],
	1180	+ Slice(BeginSlice(Args, 6)^, Length(Args) - 6)), Args[4]);
	1181	+ Exit;
	1182	+ end;
	1183	+ end
	1184	+ else if Args[3] = 'PUT' then
	1185	+ begin
	1186	+ if Length(Args) < 6 + 2 then
	1187	+ begin
	1188	+ raise EVDSError.Create;
	1189	+ end;
	1190	+
	1191	+ if Args[4] <> 'promise' then
	1192	+ begin
	1193	+ raise EVDSError.Create;
	1194	+ end;
	1195	+
	1196	+ Result := IntToStr(HLPutPropertyAsync(AllocatedOleVariant
	1197	+ (StrToInt(Args[2])), ActiveX.DISPATCH_PROPERTYPUT, Args[5],
	1198	+ Slice(BeginSlice(Args, 6)^, Length(Args) - 6)).Index);
	1199	+ Exit;
	1200	+ end
	1201	+ else if Args[3] = 'ENUMERATE' then
	1202	+ begin
	1203	+ Result := AllocateOleEnumerator(HLEnumerate((AllocatedOleVariant(StrToInt(Args[2])))));
	1204	+ Exit;
	1205	+ end
	1206	+ else if (Args[3] = 'STRING') or (Args[3] = 'UTF') or (Args[3] = 'INTEGER') or
	1207	+ (Args[3] = 'BOOLEAN') or (Args[3] = 'REAL') or (Args[3] = 'OBJECT') or
	1208	+ (Args[3] = 'THREADEDOBJECT') or (Args[3] = 'VARIANT') then
	1209	+ begin
	1210	+ Result := AllocateOleVariant(CreateOleVariant(Args[2], Args[3]));
	1211	+ Exit;
	1212	+ end
	1213	+ else
	1214	+ begin
	1215	+ raise EVDSError.Create;
	1216	+ end;
	1217	+ end
	1218	+ else if Args[1] = 'enumerator' then
	1219	+ begin
	1220	+ if Length(Args) < 4 then
	1221	+ begin
	1222	+ raise EVDSError.Create;
	1223	+ end;
	1224	+
	1225	+ if Args[3] = 'NEXT' then
	1226	+ begin
	1227	+ Result := HLNext(AllocatedOleEnumerator(StrToInt(Args[2])));
	1228	+ Exit;
	1229	+ end
	1230	+ else
	1231	+ begin
	1232	+ raise EVDSError.Create;
	1233	+ end;
	1234	+ end
	1235	+ else if Args[1] = 'promise' then
	1236	+ begin
	1237	+ if Length(Args) < 4 then
	1238	+ begin
	1239	+ raise EVDSError.Create;
	1240	+ end;
	1241	+
	1242	+ if Args[3] = 'ISCOMPLETED' then
	1243	+ begin
	1244	+ Result := HLIsCompleted(vdsoleaut.Promises.AllocatedPromise(StrToInt(Args[2])));
	1245	+ Exit;
	1246	+ end
	1247	+ else if Args[3] = 'ISRUNNING' then
	1248	+ begin
	1249	+ Result := HLIsRunning(vdsoleaut.Promises.AllocatedPromise(StrToInt(Args[2])));
	1250	+ Exit;
	1251	+ end
	1252	+ else if Args[3] = 'VALUE' then
	1253	+ begin
	1254	+ Result := AllocateOleVariant(HLPromiseValue(vdsoleaut.Promises.AllocatedPromise(StrToInt(Args[2]))));
	1255	+ Exit;
	1256	+ end
	1257	+ else if Args[3] = 'TOSTRING' then
	1258	+ begin
	1259	+ Result := HLToString(HLPromiseValue(vdsoleaut.Promises.AllocatedPromise(StrToInt(Args[2]))), True);
	1260	+ Exit;
	1261	+ end
	1262	+ else if Args[3] = 'TOUTF' then
	1263	+ begin
	1264	+ Result := HLToString(HLPromiseValue(vdsoleaut.Promises.AllocatedPromise(StrToInt(Args[2]))), False);
	1265	+ Exit;
	1266	+ end
	1267	+ else
	1268	+ begin
	1269	+ raise EVDSError.Create;
	1270	+ end;
	1271	+ end
	1272	+ else
	1273	+ begin
	1274	+ raise EVDSError.Create;
	1275	+ end;
	1276	+ end
	1277	+ else
	1278	+ begin
	1279	+ raise EVDSError.Create;
	1280	+ end;
	1281	+
	1282	+ raise EVDSError.Create;
	1283	+end;
	1284	+
	1285	+initialization
	1286	+ FormatSettings.DecimalSeparator := '.';
	1287	+finalization
	1288	+ if InitializedOle then
	1289	+ begin
	1290	+ ActiveX.OleUninitialize;
	1291	+ InitializedOle := False;
	1292	+ end;
	1293	+end.

diff -r 000000000000 -r 7b0b6c9522b8 vdsoleaut.Promises.pas

--- /dev/null Thu Jan 01 00:00:00 1970 +0000

+++ b/vdsoleaut.Promises.pas Wed Jan 30 03:08:38 2019 +0300

		@@ -0,0 +1,291 @@
	1	+(****************************************************************************\
	2	+ Copyright 2019 Levashev Ivan Aleksandrovich
	3	+
	4	+ Licensed under the Apache License, Version 2.0 (the "License");
	5	+ you may not use this file except in compliance with the License.
	6	+ You may obtain a copy of the License at
	7	+
	8	+ http://www.apache.org/licenses/LICENSE-2.0
	9	+
	10	+ Unless required by applicable law or agreed to in writing, software
	11	+ distributed under the License is distributed on an "AS IS" BASIS,
	12	+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
	13	+ See the License for the specific language governing permissions and
	14	+ limitations under the License.
	15	+\****************************************************************************)
	16	+
	17	+unit vdsoleaut.Promises;
	18	+
	19	+interface
	20	+
	21	+uses
	22	+ Classes;
	23	+
	24	+type
	25	+ IAsyncCallPromise = interface(IInterface)
	26	+ // No GUID
	27	+ function GetIndex: Integer;
	28	+ function GetIsCompleted: Boolean;
	29	+ function GetValue: OleVariant; // call from STA only !
	30	+ procedure Detach;
	31	+ function GetIsDetached: Boolean;
	32	+ procedure PostValue(Value: OleVariant); // call from MTA only !
	33	+
	34	+ property Index: Integer read GetIndex;
	35	+ property IsCompleted: Boolean read GetIsCompleted;
	36	+ property Value: OleVariant read GetValue; // get from STA only !
	37	+ property IsDetached: Boolean read GetIsDetached;
	38	+ end;
	39	+
	40	+function AllocatePromise: IAsyncCallPromise;
	41	+function AllocatedPromise(Index: Integer): IAsyncCallPromise;
	42	+procedure DeallocatePromise(Index: Integer);
	43	+procedure DeallocatePromises;
	44	+
	45	+implementation
	46	+
	47	+uses
	48	+ Windows, vdsoleaut.Impl, SysUtils, ActiveX, ComObj, Variants;
	49	+
	50	+var
	51	+ AllocatedPromises: array of IAsyncCallPromise;
	52	+
	53	+type
	54	+ TMarshalOleVariantMode = (movmNone, movmIUnknown, movmIDispatch);
	55	+ TAsyncCallPromiseImplementation = class(TInterfacedObject, IAsyncCallPromise)
	56	+ protected
	57	+ FCriticalSection: Windows.TRTLCriticalSection;
	58	+ FIndex: Integer;
	59	+ FIsCompleted: Boolean;
	60	+ FValue: OleVariant;
	61	+ FValueStream: ActiveX.IStream;
	62	+ FMarshaledMode: TMarshalOleVariantMode;
	63	+ function GetIndex: Integer;
	64	+ function GetIsCompleted: Boolean;
	65	+ function GetValue: OleVariant;
	66	+ function GetIsDetached: Boolean;
	67	+ procedure Marshal;
	68	+ procedure Unmarshal;
	69	+ public
	70	+ constructor Create(AIndex: Integer);
	71	+ destructor Destroy; override;
	72	+ procedure Detach;
	73	+ procedure PostValue(Value: OleVariant);
	74	+
	75	+ property Index: Integer read GetIndex;
	76	+ property IsCompleted: Boolean read GetIsCompleted;
	77	+ property Value: OleVariant read GetValue;
	78	+ property IsDetached: Boolean read GetIsDetached;
	79	+ end;
	80	+
	81	+function TAsyncCallPromiseImplementation.GetIndex: Integer;
	82	+begin
	83	+ EnterCriticalSection(FCriticalSection);
	84	+ try
	85	+ Result := FIndex;
	86	+ finally
	87	+ LeaveCriticalSection(FCriticalSection);
	88	+ end;
	89	+end;
	90	+
	91	+function TAsyncCallPromiseImplementation.GetIsCompleted: Boolean;
	92	+begin
	93	+ EnterCriticalSection(FCriticalSection);
	94	+ try
	95	+ Result := FIsCompleted;
	96	+ finally
	97	+ LeaveCriticalSection(FCriticalSection);
	98	+ end;
	99	+end;
	100	+
	101	+function TAsyncCallPromiseImplementation.GetValue: OleVariant;
	102	+begin
	103	+ EnterCriticalSection(FCriticalSection);
	104	+ try
	105	+ Unmarshal;
	106	+ Result := FValue;
	107	+ finally
	108	+ LeaveCriticalSection(FCriticalSection);
	109	+ end;
	110	+end;
	111	+
	112	+function TAsyncCallPromiseImplementation.GetIsDetached: Boolean;
	113	+begin
	114	+ EnterCriticalSection(FCriticalSection);
	115	+ try
	116	+ Result := FIndex < 0;
	117	+ finally
	118	+ LeaveCriticalSection(FCriticalSection);
	119	+ end;
	120	+end;
	121	+
	122	+constructor TAsyncCallPromiseImplementation.Create(AIndex: Integer);
	123	+begin
	124	+ inherited Create;
	125	+ InitializeCriticalSection(FCriticalSection);
	126	+ FIndex := AIndex;
	127	+end;
	128	+
	129	+destructor TAsyncCallPromiseImplementation.Destroy;
	130	+begin
	131	+ Unmarshal;
	132	+ DeleteCriticalSection(FCriticalSection);
	133	+
	134	+ inherited Destroy;
	135	+end;
	136	+
	137	+procedure TAsyncCallPromiseImplementation.Detach;
	138	+begin
	139	+ EnterCriticalSection(FCriticalSection);
	140	+ try
	141	+ FIndex := -1;
	142	+ finally
	143	+ LeaveCriticalSection(FCriticalSection);
	144	+ end;
	145	+end;
	146	+
	147	+procedure TAsyncCallPromiseImplementation.PostValue(Value: OleVariant);
	148	+var
	149	+ WHandle: THandle;
	150	+begin
	151	+ EnterCriticalSection(FCriticalSection);
	152	+ try
	153	+ if FIsCompleted then
	154	+ begin
	155	+ Exit;
	156	+ end;
	157	+
	158	+ FIsCompleted := True;
	159	+ FValue := Value;
	160	+ Marshal;
	161	+
	162	+ if (FIndex >= 0) and Assigned(vdsoleaut.Impl.WHandle) then
	163	+ begin
	164	+ WHandle := vdsoleaut.Impl.WHandle^;
	165	+ if (WHandle <> Windows.INVALID_HANDLE_VALUE) and (WHandle <> 0) then
	166	+ begin
	167	+ SysUtils.Win32Check(Windows.PostMessage(vdsoleaut.Impl.WHandle^,
	168	+ vdsoleaut.Impl.WM_VDSOLEASYNC, FIndex, 0));
	169	+ end;
	170	+ end;
	171	+ finally
	172	+ LeaveCriticalSection(FCriticalSection);
	173	+ end;
	174	+end;
	175	+
	176	+procedure TAsyncCallPromiseImplementation.Marshal;
	177	+begin
	178	+ case TVarData(FValue).VType of
	179	+ varDispatch:
	180	+ begin
	181	+ FMarshaledMode := movmIDispatch;
	182	+ ComObj.OleCheck(ActiveX.CoMarshalInterThreadInterfaceInStream(IDispatch, IDispatch(FValue), FValueStream));
	183	+ FValue := Variants.Unassigned;
	184	+ end;
	185	+ varUnknown:
	186	+ begin
	187	+ FMarshaledMode := movmIUnknown;
	188	+ ComObj.OleCheck(ActiveX.CoMarshalInterThreadInterfaceInStream(IUnknown, IUnknown(FValue), FValueStream));
	189	+ FValue := Variants.Unassigned;
	190	+ end;
	191	+ else
	192	+ // do nothing
	193	+ end;
	194	+end;
	195	+
	196	+procedure TAsyncCallPromiseImplementation.Unmarshal;
	197	+var
	198	+ TempD: IDispatch;
	199	+ TempU: IUnknown;
	200	+begin
	201	+ case FMarshaledMode of
	202	+ movmIDispatch:
	203	+ begin
	204	+ FMarshaledMode := movmNone;
	205	+ ComObj.OleCheck(ActiveX.CoGetInterfaceAndReleaseStream(FValueStream, IDispatch, TempD));
	206	+ FValueStream := nil;
	207	+ FValue := TempD;
	208	+ end;
	209	+ movmIUnknown:
	210	+ begin
	211	+ FMarshaledMode := movmNone;
	212	+ ComObj.OleCheck(ActiveX.CoGetInterfaceAndReleaseStream(FValueStream, IUnknown, TempU));
	213	+ FValueStream := nil;
	214	+ FValue := TempU;
	215	+ end;
	216	+ movmNone: // do nothing
	217	+ end;
	218	+end;
	219	+
	220	+function AllocatePromise: IAsyncCallPromise;
	221	+var
	222	+ L: Integer;
	223	+begin
	224	+ L := Length(AllocatedPromises);
	225	+ SetLength(AllocatedPromises, L + 1);
	226	+ Result := TAsyncCallPromiseImplementation.Create(L + 1);
	227	+ AllocatedPromises[L] := Result;
	228	+end;
	229	+
	230	+function AllocatedPromise(Index: Integer): IAsyncCallPromise;
	231	+begin
	232	+ if (Index < 1) or (Index > Length(AllocatedPromises)) then
	233	+ begin
	234	+ Result := nil;
	235	+ Exit;
	236	+ end;
	237	+
	238	+ Result := AllocatedPromises[Index - 1];
	239	+end;
	240	+
	241	+procedure DeallocatePromise(Index: Integer);
	242	+var
	243	+ L, I: Integer;
	244	+begin
	245	+ if (Index < 1) or (Index > Length(AllocatedPromises)) then
	246	+ begin
	247	+ Exit;
	248	+ end;
	249	+
	250	+ if Assigned(AllocatedPromises[Index - 1]) then
	251	+ begin
	252	+ AllocatedPromises[Index - 1].Detach;
	253	+ AllocatedPromises[Index - 1] := nil;
	254	+ end;
	255	+ L := Length(AllocatedPromises);
	256	+ for I := L - 1 downto 0 do
	257	+ begin
	258	+ if Assigned(AllocatedPromises[I]) then
	259	+ begin
	260	+ if I <> L - 1 then
	261	+ begin
	262	+ SetLength(AllocatedPromises, I + 1);
	263	+ end;
	264	+
	265	+ Exit;
	266	+ end;
	267	+ end;
	268	+
	269	+ AllocatedPromises := nil;
	270	+end;
	271	+
	272	+procedure DeallocatePromises;
	273	+var
	274	+ I: Integer;
	275	+begin
	276	+ for I := 0 to Length(AllocatedPromises) - 1 do
	277	+ begin
	278	+ if Assigned(AllocatedPromises[I]) then
	279	+ begin
	280	+ AllocatedPromises[I].Detach;
	281	+ AllocatedPromises[I] := nil;
	282	+ end;
	283	+ end;
	284	+
	285	+ AllocatedPromises := nil;
	286	+end;
	287	+
	288	+initialization
	289	+finalization
	290	+ DeallocatePromises;
	291	+end.

diff -r 000000000000 -r 7b0b6c9522b8 vdsoleaut.dpr

--- /dev/null Thu Jan 01 00:00:00 1970 +0000

+++ b/vdsoleaut.dpr Wed Jan 30 03:08:38 2019 +0300

		@@ -0,0 +1,243 @@
	1	+(****************************************************************************\
	2	+ Copyright 2019 Levashev Ivan Aleksandrovich
	3	+
	4	+ Licensed under the Apache License, Version 2.0 (the "License");
	5	+ you may not use this file except in compliance with the License.
	6	+ You may obtain a copy of the License at
	7	+
	8	+ http://www.apache.org/licenses/LICENSE-2.0
	9	+
	10	+ Unless required by applicable law or agreed to in writing, software
	11	+ distributed under the License is distributed on an "AS IS" BASIS,
	12	+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
	13	+ See the License for the specific language governing permissions and
	14	+ limitations under the License.
	15	+\****************************************************************************)
	16	+
	17	+library vdsoleaut;
	18	+
	19	+{ Important note about DLL memory management: ShareMem must be the
	20	+ first unit in your library's USES clause AND your project's (select
	21	+ Project-View Source) USES clause if your DLL exports any procedures or
	22	+ functions that pass strings as parameters or function results. This
	23	+ applies to all strings passed to and from your DLL--even those that
	24	+ are nested in records and classes. ShareMem is the interface unit to
	25	+ the BORLNDMM.DLL shared memory manager, which must be deployed along
	26	+ with your DLL. To avoid using BORLNDMM.DLL, pass string information
	27	+ using PChar or ShortString parameters. }
	28	+
	29	+uses
	30	+ SysUtils,
	31	+ Classes,
	32	+ Types,
	33	+ StrUtils,
	34	+ Dialogs,
	35	+ TypInfo,
	36	+ Windows,
	37	+ vdsoleaut.Impl in 'vdsoleaut.Impl.pas',
	38	+ vdsoleaut.Promises in 'vdsoleaut.Promises.pas';
	39	+
	40	+{$R *.res}
	41	+
	42	+const
	43	+ Buf_Size = 0; { parameter buffer size (user-definable) }
	44	+
	45	+var
	46	+ AHandle: THandle; { application handle }
	47	+ ErrorCode: Integer;
	48	+ ResultBuffer: AnsiString;
	49	+
	50	+function Init(Handle: THandle; Addr: vdsoleaut.Impl.TVDSExtEventProc; KeyString: PChar; var MaxPar, BufSize: Integer): PChar; export; cdecl; forward;
	51	+(*
	52	+This function is called when the extension is declared using the EXTERNAL
	53	+command.
	54	+
	55	+Handle is the DialogScript application's handle, which is passed in case
	56	+it is needed by any of the DLL functions.
	57	+
	58	+Addr is the address of the callback function which is used so that the
	59	+extension DLL can notify VDS of events.
	60	+
	61	+KeyString can be anything, including null. It is the contents of the second
	62	+parameter to the EXTERNAL command. It could be used, for example, to pass
	63	+a serial number code so the DLL can check whether the calling program is
	64	+licensed to use it, or a version number so the DLL can check if it is
	65	+compatible. The string can be used for anything you like.
	66	+
	67	+Any initialisation of the DLL should be performed during this function.
	68	+
	69	+If everything is OK then the DLL should return a string containing the name
	70	+of the command/function which will be used to call the extension. If something
	71	+is wrong then a null string should be returned, which will cause VDS to halt
	72	+with an error.
	73	+*)
	74	+
	75	+function CommandProc(Params: PAnsiChar): Integer; export; cdecl; forward;
	76	+(*
	77	+This function is called when the extension command is called. The parameters
	78	+on the command line are passed in Params as a series of concatenated null
	79	+terminated strings, and can be read using the NextParam function.
	80	+
	81	+The return value should be:
	82	+ 0 - everything OK: OK indicator left true
	83	+ -1 - non-fatal error: OK indicator set false;
	84	+ >0 - a standard VDS error code (errno is set to this)
	85	+*)
	86	+
	87	+function FuncProc(Args: PAnsiChar): PAnsiChar; export; cdecl; forward;
	88	+(*
	89	+This function is called when the extension function is called. The arguments
	90	+are passed in Args as a series of concatenated null terminated strings, and
	91	+can be read using the NextParam function.
	92	+
	93	+The return value is the string value that is substituted for the function.
	94	+
	95	+The function StatProc is called immediately after FuncProc to get the value
	96	+of OK / errorcode.
	97	+*)
	98	+
	99	+function StatProc: Integer; export; cdecl; forward;
	100	+(*
	101	+This function is called by VDS immediately after FuncProc to obtain the
	102	+value of OK and errorcode.
	103	+*)
	104	+
	105	+{ begin utility functions (not exported) }
	106	+function ParamsToArray(Params: PAnsiChar): Types.TStringDynArray;
	107	+var
	108	+ InternalBuffer: AnsiString;
	109	+ ResultLength: Integer;
	110	+ Was_Zero, Next_Zero: Integer;
	111	+ ParamsEnd: PAnsiChar;
	112	+begin
	113	+ ResultLength := 0;
	114	+ Result := nil;
	115	+ if Params = nil then
	116	+ begin
	117	+ Exit;
	118	+ end;
	119	+ ParamsEnd := Params + Types.PInteger(Params - 4)^ - 1;
	120	+ while (ParamsEnd >= Params) and (ParamsEnd^ = #0) do
	121	+ begin
	122	+ Dec(ParamsEnd);
	123	+ end;
	124	+ if ParamsEnd + 1 = Params then
	125	+ begin
	126	+ Exit;
	127	+ end;
	128	+ SetString(InternalBuffer, Params, ParamsEnd - Params + 1);
	129	+
	130	+ Was_Zero := 0;
	131	+ Next_Zero := Pos(#0, InternalBuffer);
	132	+ while Next_Zero > 0 do
	133	+ begin
	134	+ SetLength(Result, ResultLength + 1);
	135	+ Result[ResultLength] := Copy(InternalBuffer, Was_Zero + 1, Next_Zero - Was_Zero - 1);
	136	+ Inc(ResultLength);
	137	+ Was_Zero := Next_Zero;
	138	+ Next_Zero := StrUtils.PosEx(#0, InternalBuffer, Was_Zero + 1);
	139	+ end;
	140	+
	141	+ if Was_Zero <> Length(InternalBuffer) then
	142	+ begin
	143	+ SetLength(Result, ResultLength + 1);
	144	+ Result[ResultLength] := Copy(InternalBuffer, Was_Zero + 1, Length(InternalBuffer) - Was_Zero);
	145	+ end;
	146	+end;
	147	+
	148	+{ end utility functions }
	149	+
	150	+{ begin exported functions }
	151	+
	152	+var
	153	+ InitResult: AnsiString;
	154	+
	155	+function Init(Handle: THandle; Addr: vdsoleaut.Impl.TVDSExtEventProc; KeyString: PAnsiChar; var MaxPar, BufSize: Integer): PAnsiChar;
	156	+var
	157	+ KeyStringAsString: AnsiString;
	158	+begin
	159	+ AHandle := Handle;
	160	+ vdsoleaut.Impl.EventProc := Addr;
	161	+ vdsoleaut.Impl.WHandle := Windows.PHandle(MaxPar);
	162	+ MaxPar := vdsoleaut.Impl.Max_Parameters;
	163	+ BufSize := Buf_Size;
	164	+ { start user-defined code }
	165	+ SetString(KeyStringAsString, KeyString, Types.PInteger(KeyString - 4)^);
	166	+ try
	167	+ InitResult := vdsoleaut.Impl.HLInit(KeyStringAsString);
	168	+ Result := PAnsiChar(InitResult);
	169	+ except
	170	+ on E: vdsoleaut.Impl.EVDSError do
	171	+ begin
	172	+ ErrorCode := E.ErrorCode;
	173	+ Result := '';
	174	+ end;
	175	+ on E: Exception do
	176	+ begin
	177	+ vdsoleaut.Impl.MessageException(E);
	178	+ ErrorCode := 32;
	179	+ Result := '';
	180	+ end;
	181	+ end;
	182	+ Exit;
	183	+ { end user-defined code (remember to set Result) }
	184	+end;
	185	+
	186	+function CommandProc(Params: PAnsiChar): Integer;
	187	+begin
	188	+ Result := 0;
	189	+ try
	190	+ vdsoleaut.Impl.HLCommandProc(ParamsToArray(Params));
	191	+ except
	192	+ on E: vdsoleaut.Impl.EVDSError do
	193	+ begin
	194	+ Result := E.ErrorCode;
	195	+ Exit;
	196	+ end;
	197	+ on E: Exception do
	198	+ begin
	199	+ vdsoleaut.Impl.MessageException(E);
	200	+ Result := 32;
	201	+ Exit;
	202	+ end;
	203	+ end;
	204	+end;
	205	+
	206	+var
	207	+ FuncResult: AnsiString;
	208	+
	209	+function FuncProc(Args: PAnsiChar): PAnsiChar;
	210	+begin
	211	+ ErrorCode := 0;
	212	+ try
	213	+ FuncResult :=
	214	+ vdsoleaut.Impl.HLFunctionProc(ParamsToArray(Args));
	215	+ Result := PAnsiChar(FuncResult);
	216	+ except
	217	+ on E: vdsoleaut.Impl.EVDSError do
	218	+ begin
	219	+ ErrorCode := E.ErrorCode;
	220	+ Result := '';
	221	+ Exit;
	222	+ end;
	223	+ on E: Exception do
	224	+ begin
	225	+ vdsoleaut.Impl.MessageException(E);
	226	+ ErrorCode := 32;
	227	+ Result := '';
	228	+ Exit;
	229	+ end;
	230	+ end;
	231	+end;
	232	+
	233	+function StatProc: Integer;
	234	+{ this function requires no modification }
	235	+begin
	236	+ Result := ErrorCode;
	237	+end;
	238	+
	239	+exports
	240	+ Init, CommandProc, FuncProc, StatProc;
	241	+
	242	+begin
	243	+end.

Show on old repository browser

vds-ole-bridge Fork

VDS_OLE_Bridge: Commit

Commit MetaInfo

Log Message

Change Summary

Incremental Difference

vds-ole-bridge
Fork