VB Forum / COM / October 2007

Thought about the CreateWindowEx-API instead of
"VBRuntime-Controlled Forms". This should work -
even in 'Unattended execution-mode' - the whole OLE-
Marshalling is using hidden forms under the hood - and
this works well, even without any loaded desktop
in "pure service-mode".

But you are right, there are of course additional ways, to
make two pointer-values (and maybe the Array-Count too)
available in a fast way (without any marshalled calls) to STAs,
wich need them.

Regards,

Olaf

Ah Ok - long time ago, since I used the IIS and its
environment (in some older version this has worked).

Ok, then try this approach:
(just tested this with an IIS, wich was installed and
updated with VS2005-Express - and it works well,
no global.asa, no special initializing)

Simply use an *.asp-script (called from a browser) for testing.
<% Server.CreateObject("Your.ProgID").DoIt Response %>

You can adjust the UserEntries in the Demo and watch
the Memory-consumption of dllhost.exe in the TaskManager.

'And this goes into a Public Class in an AX-Dll
Option Explicit

Private Type TGlob 'always use fixed length strings inside the Types
 Initiated As String * 10
 LastThreadID As Long
 LastAccess As Date
 MaxArrEntryCount As Long
 CurArrEntryCount As Long
 '...
End Type

Private Type TGlobArray 'always use fixed length strings inside the Types
 ID As Long
 UserName As String * 128
 '...
End Type

Private Declare Sub RtlMoveMemory Lib "kernel32" _
 (Dst As Any, Src As Any, ByVal bc&)
Private Declare Function ArrPtr& Lib "msvbvm60" Alias "VarPtr" _
 (Arr() As Any)
Private Declare Function CloseHandle& Lib "kernel32" _
 (ByVal hObj&)
Private Declare Function CreateFileMappingA& Lib "kernel32" _
 (ByVal hFile&, Attr As Any, ByVal Protect&, ByVal SizeHigh&, _
  ByVal SizeLow&, ByVal MapName$)
Private Declare Function MapViewOfFile& Lib "kernel32" _
 (ByVal hFile&, ByVal DesAccess&, ByVal OffsHigh&, ByVal OffsLow&, _
  ByVal NumberOfBytesToMap&)
Private Declare Function UnmapViewOfFile& Lib "kernel32" _
 (ByVal lpBaseAddress As Long)

Private Const MapKey$ = "MyMapKey", FILE_MAP_ALL_ACCESS& = &HF001F

Private Const MaxUsers& = 100

Private Glob() As TGlob, saGlob&(5)
Private Users() As TGlobArray, saUsers&(5)
Private BaseAddr&, hFile&, Initiator As Boolean

Public Sub DoIt(Response)
Dim i As Long, NewUserIdx As Long

 If BaseAddr = 0 Then Exit Sub

 With Glob(0)
   Response.Write "<PRE>"
   Response.Write "Global BaseData:<BR>"
   Response.Write "  LastThreadID: " & .LastThreadID & "<BR>"
   Response.Write "  CurrentThreadID: " & App.ThreadID & "<BR>"
   Response.Write "  LastAccess: " & .LastAccess & "<BR>"
   Response.Write "  CurrentAccess: " & Now & "<BR><BR>"

   .LastThreadID = App.ThreadID
   .LastAccess = Now

   Response.Write "We have enough memory for: " & _
                  .MaxArrEntryCount & " Users<BR><BR>"
   'lets Add another User
   NewUserIdx = .CurArrEntryCount
   If NewUserIdx < .MaxArrEntryCount Then
     .CurArrEntryCount = NewUserIdx + 1
     'Now we have time, to fill in the members at the NewUserIdx
     With Users(NewUserIdx)
       .ID = NewUserIdx + 1
       .UserName = "UserName_" & .ID & vbNullChar
     End With
     NewUserIdx = NewUserIdx + 1
   End If

   Response.Write "Current UserList has: " & NewUserIdx & " Users<BR>"
   For i = 0 To NewUserIdx - 1
     With Users(i)
       Response.Write "  UserID: " & .ID & _
                      ", UserName: " & F2S(.UserName) & "<BR>"
     End With
   Next i
   Response.Write "</PRE>"
 End With
End Sub

Private Sub Class_Initialize()
Dim GlobDummy As TGlob, MapBaseSize&
Dim GlobArrayDummy As TGlobArray, MapUserSize&
 MapBaseSize = LenB(GlobDummy) 'always use LenB
 MapUserSize = LenB(GlobArrayDummy) * MaxUsers 'always use LenB

 'Initialize safearray-descriptor
 saGlob(0) = 1 'Dimension
 saGlob(1) = LenB(GlobDummy) 'size of Member
 saGlob(4) = 1 'Number of Array-Elements
 'array-binding (bind descriptor to the Glob-Arr)
 RtlMoveMemory ByVal ArrPtr(Glob), VarPtr(saGlob(0)), 4

 'now the same for the User-Array
 saUsers(0) = 1 'Dimension
 saUsers(1) = LenB(GlobArrayDummy) 'size of Member
 saUsers(4) = MaxUsers 'Number of Array-Elements
 'array-binding (bind descriptor to the Users-Arr)
 RtlMoveMemory ByVal ArrPtr(Users), VarPtr(saUsers(0)), 4

 'do the Mapping inside the SwapFile
 hFile = CreateFileMappingA(-1, ByVal 0&, 4, 0&, _
         MapBaseSize + MapUserSize, MapKey)
 If hFile = 0 Then Exit Sub

 BaseAddr = MapViewOfFile(hFile, FILE_MAP_ALL_ACCESS&, 0&, 0&, 0&)
 If BaseAddr = 0 Then Exit Sub

 saGlob(3) = BaseAddr 'set the DataPointer to the mapped area
 If F2S(Glob(0).Initiated) <> "Initiated" Then
   Initiator = True
   Glob(0).Initiated = "Initiated" & vbNullChar
   Glob(0).MaxArrEntryCount = MaxUsers
 End If

 'finally we set the Users-DataPointer behind the Glob-Data
 saUsers(3) = BaseAddr + MapBaseSize
End Sub

Private Sub Class_Terminate()
 RtlMoveMemory ByVal ArrPtr(Glob), 0&, 4 'reset array-binding
 RtlMoveMemory ByVal ArrPtr(Users), 0&, 4 'reset array-binding

 If Not Initiator Then 'if we are not the initiator, let's cleanup here
   If BaseAddr Then UnmapViewOfFile BaseAddr: BaseAddr = 0
   If hFile Then CloseHandle hFile: hFile = 0
 End If
End Sub

Private Function F2S$(FLStr$) 'Helper to convert fixed to BSTR
Dim Pos&
 Pos = InStr(FLStr, vbNullChar)
 If Pos Then F2S = Left$(FLStr, Pos - 1)
End Function

Olaf