LotusScript call to NSFItemInfoNext on Domino 64 bit server crashes server - 64-bit

I'm trying to make a call from a LotusScript agent to 'NSFItemInfoNext' on a Domino 9.0.1 64-bit server. The call to 'NSFItemInfo' succeeds. The code has been tested on a 32-bit and works correctly. The field is a rich text field broken into several items.
Type BLOCKID64
Pool As Long
Block As Integer
End Type
Declare Function W64_NSFItemInfo Lib LIB_W32 Alias "NSFItemInfo" (ByVal noteHandle As Long, ByVal itemName As String, ByVal nameLength As Integer, itemBlockID As BLOCKID64, valueDataType As Integer, valueBlockID As BLOCKID64, valueLength As Long) As Integer
Declare Function W64_NSFItemInfoNext Lib LIB_W32 Alias "NSFItemInfoNext" (ByVal noteHandle As Long, ByVal prevItemBlockIDPool As Long, ByVal prevItemBlockIDBlock As Integer, ByVal itemName As String, ByVal nameLength As Integer, itemBlockID As BLOCKID64, valueDatatype As Integer, valueBlockID As BLOCKID64, valueLength As Long) As Integer
Dim dbHandle As Long
Dim noteHandle As Long
Dim RTItemName As String
Dim ItemBlockID As BLOCKID64
Dim ItemDataType As Integer
Dim ValueBlockID As BLOCKID64
Dim ValueLength As Long
Dim NextItemBlockID As BLOCKID64
Dim NextItemDataType As Integer
Dim NextValueBlockID As BLOCKID64
Dim NextValueLength As Long
Dim StatusResult As Integer
RTItemName = "Body"
NSFDbOpen - dbHandle: 377
NSFNoteOpen - noteHandle: 43
StatusResult = W64_NSFItemInfo(noteHandle, RTItemName, Len(RTItemName), ItemBlockID, ItemDataType, ValueBlockID, ValueLength)
Results of call to NSFItemInfo:
itemBlockID.Pool: 43
itemBlockID.Block: 31312
itemDataType: 1
valueBlockID.Pool: 43
valueBlockID.Block: 1120
valueLength: 30176
StatusResult = W64_NSFItemInfoNext(noteHandle, ItemBlockID.Pool, ItemBlockID.Block, RTItemName, Len(RTItemName), NextItemBlockID, NextItemDataType, NextItemValueBlockID, NextItemValueLength)
Call to NSFItemInfoNext fails with the following crash:
############################################################
### thread 10/11: [ nAMgr: 1ca4: 0c60] FATAL THREAD
### FP=0x185ba4c8, PC=0x7723695a, SP=0x185ba4c8
### stkbase=0x185c0000, total stksize=1048576, used stksize=23352
### EAX=0x0000db76, EBX=0x00000538, ECX=0x185b9518, EDX=0xFFFFFFFF01E6AF0
### ESI=0x00000000, EDI=0x00000000, CS=0x00000033, SS=0xFFFFFFF0000002B
### DS=0x00000000, ES=0x00000000, FS=0x00000000, GS=0xFFFFFFF00000000 Flags=0x00000287
############################################################
[ 1] 0x7723695a ntdll.ZwWaitForSingleObject+10 (0,0,0,0)
[ 2] 0x76d6aeb0 kernel32.WaitForSingleObjectEx+160 (538,185babb0,0,538)
#[ 3] 0x7FEE2846AA2 nnotes.OSRunExternalScript+1666 (1ca4,0,426,5)
#[ 4] 0x7FEE28472EA nnotes.FRTerminateWindowsResources+1738 (0,5,1,2b9190)
#[ 5] 0x7FEE2847A79 nnotes.OSFaultCleanupExt+1177 (185bbe60,772f9d40,185bf9d0,1)
#[ 6] 0x7FEE2848077 nnotes.OSFaultCleanup+23 (772f9d40,2a2,29,185bb3e0)
#[ 7] 0x7FEE28AA997 nnotes.OSNTUnhandledExceptionFilter+423 (185bbe60,772f9d40,30,185bbe60)
[ 8] 0x76dfcbef kernel32.UnhandledExceptionFilter+351 (185bbe60,4a04f3ca,0,1)
[ 9] 0x77261348 ntdll.RtlInitializeAtomPackage+72 (7FEE4623CB0,13000000016,200005445,29)
[10] 0x77228ec4 ntdll.__C_specific_handler+140 (185bf9d0,185bf9d0,185c0000,77216411)
[11] 0x7722546d ntdll.RtlIntegerToChar+1341 (1,0,185bf9d0,185c0000)
[12] 0x77229267 ntdll.__C_specific_handler+1071 (185bca40,2598ca4,0,771f0000)
[13] 0x7723687a ntdll.KiUserExceptionDispatcher+46 (2598ca4,2b,185bcb88,188fc110)
#[14] 0x7FEE350B7C4 nnotes.NSFItemInfoNext+100 (185bcd20,2b,188fc7a0,188fc110)
#[15] 0x7FEE3B29803 nnotes.LSsThread::DoCCallout+6355 (ffff,188fc758,0,2598ca4)
#[16] 0x7FEE3B2B3FF nnotes.LSsThread::CProdCallFunction+431 (2598ca4,185bd7c8,23,ffe8)
#[17] 0x7FEE3AED292 nnotes.LSsThread::NRun+8722 (188fc110,185b08a4,3,2)
#[18] 0x7FEE3AEDAD8 nnotes.LSsThread::Run+296 (188fc110,76b9028,0,2)
#[19] 0x7FEE3AA7C3A nnotes.LSIThread::RunInternal+106 (76b9028,76b9028,0,0)
#[20] 0x7FEE3AA7EF6 nnotes.LSIThread::RunToCompletion+390 (76a8b28,76a8b28,185bdb30,0)
#[21] 0x7FEE3AA0CAA nnotes.CLSIDocument::RunScript+762 (76aa828,76a8aa8,0,76a8aa8)
#[22] 0x7FEE2F1B8EC nnotes.CRawActionLotusScript::Run+668 (20000200,7FE00000026,C2520646E756F46,56D756300000026)
#[23] 0x7FEE2F16E5F nnotes.CRawAction::Run+95 (0,76a8a68,76aa828,7FEE28F0005)
#[24] 0x7FEE2F17B44 nnotes.CRawAction::Execute+260 (ff,0,0,8f9b)
#[25] 0x7FEE2F1497E nnotes.CAssistant::Run+4174 (200002bf,185bea40,76a8b28,0)
#[26] 0x7FEE2F32B9F nnotes.AgentRun+1711 (1,0,0,10)
#[27] 0x7FEF99F8420 namgrdll.ExecConsoleAgent+320 (80,adc92,76aa828,76aa028)
#[28] 0x7FEE2858B52 nnotes.ThreadWrapper+258 (0,0,0,0)
[29] 0x76d5aefd kernel32.BaseThreadInitThunk+13 (0,0,0,0)
[30] 0x77216411 ntdll.RtlUserThreadStart+33 (0,0,0,0)
I've tried changing 'Pool' in BLOCKID64 structure to Double but that didn't work and caused the value returned to 'Block' to be 0 (zero).
Any thoughts or suggestions? Has anyone else had issues with 64-bit API calls from LotusScript.

I would suggest to change ItemBlockID to Double instead of using a structure. You do not use this structure anyway (for anything else than passing in the next call).
Declare Function W64_NSFItemInfo Lib LIB_W32 Alias "NSFItemInfo" (ByVal noteHandle As Long, ByVal itemName As String, ByVal nameLength As Integer, itemBlockID As Double, valueDataType As Integer, valueBlockID As BLOCKID64, valueLength As Long) As Integer
Declare Function W64_NSFItemInfoNext Lib LIB_W32 Alias "NSFItemInfoNext" (ByVal noteHandle As Long, ByVal prevItemBlockIDDbl As As Double, ByVal itemName As String, ByVal nameLength As Integer, itemBlockID As BLOCKID64, valueDatatype As Integer, valueBlockID As BLOCKID64, valueLength As Long) As Integer
About the question if anybody got problems using with 64-bit API calls from LotusScript - I'd be surprised if anybody has managed to "go all the way". For example once you get the items, you might want to read the content... I'm still stuck on that one :-/ I thought I have figured it out... but where is that code :-)

Related

Optimal means of obtaining cell address column letter from column index and column index from column letter

Typically the accepted approach is to do the following
Number to Letter
public function numberToLetter(ByVal i as long) as string
Dim s as string: s = cells(1,i).address(false,false)
numberToLetter = left(s,len(s)-1)
end function
Letter to Number
Public Function letterToNumber(ByVal s As String) As Long
letterToNumber = Range(s & 1).Column
End Function
However neither of these are particular optimal, as in each case we are creating an object, and then calling a property accessor on the object. Is there a faster approach?
Summary
The core thing to realise is that the lettering system used in Excel is also known as Base26. NumberToLetter is encoding to Base26 from decimal, and LetterToNumber is decoding from Base26 to decimal.
Base conversion can be done with simple loops and
Function base26Encode(ByVal iDecimal As Long) As String
if iDecimal <= 0 then Call Err.Raise(5, "base26Encode" ,"Argument cannot be less than 0")
if iDecimal >= 16384 then Call Err.Raise(5, "base26Encode" ,"There are only 16384 columns in a spreadsheet, thus this function is limited to this number.")
Dim s As String: s = ""
Do
Dim v As Long
v = (iDecimal - 1) Mod 26 + 1
iDecimal = (iDecimal - v) / 26
s = Chr(v + 64) & s
Loop Until iDecimal = 0
base26Encode = s
End Function
Function base26Decode(ByVal sBase26 As String) As Long
sBase26 = UCase(sBase26)
Dim sum As Long: sum = 0
Dim iRefLen As Long: iRefLen = Len(sBase26)
For i = iRefLen To 1 Step -1
sum = sum + (Asc((Mid(sBase26, i))) - 64) * 26 ^ (iRefLen - i)
Next
base26Decode = sum
End Function
Performance
I tested the performance of these functions against the original functions. To do this I used the stdPerformance class of stdVBA.
The code used for testing is as follows:
Sub testPerf()
Dim cMax As Long: cMax = 16384
With stdPerformance.Measure("Encode Original")
For i = 1 To cMax
Call numberToLetter(i)
Next
End With
With stdPerformance.Measure("Encode Optimal")
For i = 1 To cMax
Call base26Encode(i)
Next
End With
With stdPerformance.Measure("Decode Original")
For i = 1 To cMax
Call letterToNumber(base26Encode(i))
Next
End With
With stdPerformance.Measure("Decode Optimal")
For i = 1 To cMax
Call base26Decode(base26Encode(i))
Next
End With
End Sub
The results for which are as follows:
Encode Original: 78 ms
Encode Optimal: 31 ms
Decode Original: 172 ms
Decode Optimal: 63 ms
As shown this is a slightly faster approach (2-3x faster). I am fairly surprised that object creation and property access performed so well however.

VBA function returns #VALUE in excel with the message: A value in the formula is off the wrong data type

I am a just beginning to learn VBA. I am trying to do a loop that will act as a solver to find the number of payments for a loan:
Function FonctionValue(rate As Double, pmt1 As Double, loan As Double, nbpmt As Double)
FonctionValue = Application.WorksheetFunction.pmt(rate, nbpmt, loan) - pmt1
End Function
Function Npmt(nbpmtlow As Double, nbpmthigh As Double, rate As Double, loan As Double, pmt1 As Double) As Variant
Dim i As Integer
Dim nbpmt As Double
For i = 1 To 100
flow = FonctionValue(rate, pmt1, loan, nbpmtlow)
fhigh = FonctionValue(rate, pmt1, loan, nbpmthigh)
value = nbpmtlow - flow * (nbpmthigh - nbpmtlow) / (fhigh - flow)
fnbpmt = FonctionValue(rate, pmt1, loan, nbpmt)
If fhigh * fnbpmt > 0 Then
nbpmthigh = value
Else
nbpmtlow = value
End If
Next i
value = Npmt
End Function
The main issues:
In the line fnbpmt = FonctionValue(rate, pmt1, loan, nbpmt), nbmpt = 0. This is an invalid input to WorksheetFunction.Pmt. It's not immediately clear what nbpmt should be, but it must be greater than 0.
Change value = Npmt to Npmt = Value; you have the order backwards.

VBA : For loop exiting without returning the value

I have the following piece for code to simulate stock prices using stochastic process
Function varswap1(s0, r0, sigma0, t) As Double
Rnd (-10)
Randomize (999)
Dim i As Integer, j As Integer, r As Double
Dim stock() As Double, dt As Double
Dim per As Integer
per = WorksheetFunction.Round(t * 252, 0)
ReDim stock(per)
stock(1) = s0
dt = 1 / 252
For i = 1 To per
stock(i + 1) = stock(i) * Exp((r0 - 0.5 * sigma0 ^ 2) * dt + sigma0 * Sqr(dt) * WorksheetFunction.NormSInv(Rnd()))
Next
varswap1 = WorksheetFunction.Average(stock)
End Function
In this code, I ran debugging by placing a break point at Next and the entire For loop is working absolutely fine. The problem is after completing the loop the function exits and #VALUE! error is displayed in the cell.
I am not able to figure out what is wrong with this code.
Will be thankful if anyone can help me with it.
Try this:
Const n As Integer = 252
Function varswap1(s0, r0, sigma0, t) As Double
Rnd (-10)
Randomize (999)
Dim i As Integer, j As Integer, r As Double
Dim stock() As Double, dt As Double
Dim per As Integer
per = WorksheetFunction.Round(t * n, 0)
ReDim stock(per)
stock(0) = s0 ' First item in the array has index 0
dt = 1# / n ' Avoid integer division, 1/252 = 0
For i = 1 To per
'Each stock depends on the previous stock value:
stock(i) = stock(i - 1) * Exp((r0 - 0.5 * sigma0 ^ 2) * dt + sigma0 * Sqr(dt) * WorksheetFunction.NormSInv(Rnd()))
Next
varswap1 = WorksheetFunction.Average(stock)
End Function
I saw two issues and one suggestion.
One is the array stock goes from 0..252 but you assign values to 1..253 so it crashes.
Also there is a possible integer division resulting in dt=0.0. I updated the definition to make the intent clear that the division is to be done after the conversion from integer to double. Lastly, I moved the magic number 252 to a constant.

Excel VBA: Communicating via named pipe

I am trying to setup communication via a named pipe in VBA unfortunately for some reason it never gets to the line Debug.Print "Connected in the server, nor does the client connect. Seems like a simple scenario but been trying to get this going for hours.
Server
Public Sub Server()
Const szPipeName = "\\.\pipe\bigtest"
Dim hPipe As Long, readVal As Long, readBytes As Long, sendVal As Long, sentBytes As Long
Dim sa As SECURITY_ATTRIBUTES
'Create the NULL security token for the pipe
pSD = GlobalAlloc(GPTR, SECURITY_DESCRIPTOR_MIN_LENGTH)
res = InitializeSecurityDescriptor(pSD, SECURITY_DESCRIPTOR_REVISION)
res = SetSecurityDescriptorDacl(pSD, -1, 0, 0)
sa.nLength = LenB(sa)
sa.lpSecurityDescriptor = pSD
sa.bInheritHandle = True
'Create the Named Pipe
hPipe = CreateNamedPipe(szPipeName, PIPE_ACCESS_DUPLEX, PIPE_WAIT Or PIPE_TYPE_MESSAGE Or PIPE_READMODE_MESSAGE, 10, 1000, 1000, 10000, sa)
'Create separate thread as client
ID = CreateThread(nil, 0, AddressOf ClientThread, nil, 0, nil)
Debug.Print "Created thread: " & ID
Debug.Print "Connecting named pipe: " & hPipe
res = ConnectNamedPipe(hPipe, ByVal 0)
'XXXXXXXXXXXXXXXXX NEVER GETS HERE XXXXXXXXXXXXXXXXXXx
Debug.Print "Connected"
'Read/Write data over the pipe
res = ReadFile(hPipe, readVal, LenB(readVal), readBytes, ByVal 0)
Debug.Print "Read file: " & readVal
'res = WriteFile(hPipe, sendVal , LenB(sendVal ), sendBytes, ByVal 0)
res = FlushFileBuffers(hPipe)
res = DisconnectNamedPipe(hPipe)
'Close the pipe handle
CloseHandle hPipe
GlobalFree (pSD)
End Sub
Client
Public Sub ClientThread()
Const szPipeName As String = "\\.\pipe\bigtest"
Dim sentBytes As Long, sendVal As Long, fSuccess As Boolean, readVal As Long, readBytes As Long
sendVal = 500
'Give server time to ConnectNamedPipe
Sleep 2000
Debug.Print "Connecting to pipe..."
fSuccess= CallNamedPipe(szPipeName, sendVal, LenB(sendVal), readVal, LenB(readVal), readBytes, 5000)
'XXXXXXXXXXXXXX NEVER GETS HERE XXXXXXXXXXXXXX
Debug.Print "Successful: " & fSuccess
'...
End Sub
(this is my first answer -- time to give back)
Let me show you an example of this working. In the following example, I'll give you the VBA macro module code for a a function Excel to send an message to a server, the server to read the message, the server to compose a response, and excel to receive the response. we'll do this using a message that is a string, but you can take this further and create a protocol you would like to use over this pipe.
Remember that Excel macros are single threaded and event driven -- and so the way it makes sense to use named pipes in excel is as a client -- to in response to an event, send a request to a server and receive a response from that server (much like a web GET or POST sends a request and gets a response then closes the connection)
In this example, we used the method CallNamedPipeA in kernel32
(note that this is written for 64 bit excel. If using 32 bit, you exclude the "PtrSafe") This method connects to a named pipe in Message Mode, sends a message, receives a message, and then closes the connection.
The c# server code is taken largely from a Microsoft example, but we must convert it to handle message mode and had it restart a new thread when each pipe is closed. Thus there are always 4 threads waiting for clients to connect.
Quick note on Strings. Remember Excel uses Unicode. We should use UTF8 or byte arrays over named pipes.
Call the sub testPipe in Excel to see this work.
Excel VBA (client)
Option Explicit
Declare PtrSafe Function CallNamedPipe Lib "kernel32" Alias _
"CallNamedPipeA" ( _
ByVal lpNamedPipeName As String, _
lpInBuffer As Any, _
ByVal nInBufferSize As Long, _
lpOutBuffer As Any, _
ByVal nOutBufferSize As Long, _
lpBytesRead As Long, _
ByVal nTimeOut As Long) As Long
Private Sub testPipe()
Dim ms As String
Dim mr As String
Dim returncode As Long
ms = "Message from client;Hello World"
returncode = namedPipeMessageExchange("testpipe", ms, mr)
If returncode <> 0 Then
Debug.Print "Sent: " & ms
Debug.Print "received: " & mr
End If
End Sub
Public Function namedPipeMessageExchange(pipe As String, messageToSend As String, messageReceived As String) As Long
Dim res As Long, myStr As String, i As Long, cbRead As Long, sm As String
Dim numBytes As Long, bArray() As Byte, temp As String
Dim b() As Byte
Dim blen As Long
b = StrConv(messageToSend, vbFromUnicode)
blen = UBound(b) - LBound(b) + 1
If blen = 0 Then b = Array(1)
numBytes = 1000000
ReDim bArray(numBytes) 'Build the return buffer
'Call CallNamedPipe to do the transaction all at once
res = CallNamedPipe("\\.\pipe\" + pipe, b(0), blen, _
bArray(0), numBytes, _
cbRead, 3000) 'Wait up to 3 seconds for a response
If res > 0 Then
ReDim Preserve bArray(0 To cbRead - 1)
messageReceived = StrConv(bArray, vbUnicode)
'Debug.Print "received: " & messageReceived
Else
Debug.Print "Error number " & Err.LastDllError & _
" attempting to call CallNamedPipe.", vbOKOnly
End If
namedPipeMessageExchange = res
End Function
c# (server)
using System;
using System.Collections.Generic;
using System.IO;
using System.IO.Pipes;
using System.Text;
using System.Threading;
public class PipeServer
{
private static int numThreads = 4;
public static void Main()
{
int i;
Thread[] servers = new Thread[numThreads];
Console.WriteLine("\n*** Named pipe server stream with impersonation example ***\n");
Console.WriteLine("Waiting for client connect...\n");
for (i = 0; i < numThreads; i++)
{
servers[i] = new Thread(ServerThread);
servers[i].Start();
}
Thread.Sleep(250);
while (i > 0)
{
for (int j = 0; j < numThreads; j++)
{
if (servers[j] != null)
{
if (servers[j].Join(250))
{
Console.WriteLine("Server thread[{0}] finished.", servers[j].ManagedThreadId);
servers[j] = null;
servers[j] = new Thread(ServerThread);
servers[j].Start();
//i--; // decrement the thread watch count
}
}
}
}
Console.WriteLine("\nServer threads exhausted, exiting.");
}
private static void ServerThread(object data)
{
NamedPipeServerStream pipeServer =
new NamedPipeServerStream("testpipe", PipeDirection.InOut, numThreads, PipeTransmissionMode.Message);
int threadId = Thread.CurrentThread.ManagedThreadId;
// Wait for a client to connect
pipeServer.WaitForConnection();
Console.WriteLine("Client connected on thread[{0}].", threadId);
try
{
List<byte> intext = new List<byte>();
do
{
byte[] x = new byte[1024*16];
int read = 0;
read = pipeServer.Read(x);
Array.Resize(ref x, read);
intext.AddRange(x);
} while (!pipeServer.IsMessageComplete);
string receivedText = System.Text.Encoding.UTF8.GetString(intext.ToArray());
string sentText = "I am the server!";
pipeServer.Write(System.Text.Encoding.UTF8.GetBytes(sentText));
Console.WriteLine("Received Text: "+receivedText);
Console.WriteLine("Sent Text: " + sentText);
}
// Catch the IOException that is raised if the pipe is broken
// or disconnected.
catch (IOException e)
{
Console.WriteLine("ERROR: {0}", e.Message);
}
//pipeServer.WaitForPipeDrain();
pipeServer.Close();
}
}

How can I find user's time zone offset in excel

I am using an excel macro to generate an RSS feed. The user's timezone offset needs to go in the field of the RSS feed. How can I do this programatically in the excel macro function?
Paste the following code into a module in Excel:
Private Declare Function GetTimeZoneInformationAny Lib "kernel32" Alias _
"GetTimeZoneInformation" (buffer As Any) As Long
Function GetTimeZone() As Single
Dim retval As Long
Dim buffer(0 To 42) As Long
Const TIME_ZONE_ID_INVALID = &HFFFFFFFF
Const TIME_ZONE_ID_UNKNOWN = 0
Const TIME_ZONE_ID_STANDARD = 1
Const TIME_ZONE_ID_DAYLIGHT = 2
retval = GetTimeZoneInformationAny(buffer(0))
Select Case retval
Case TIME_ZONE_ID_INVALID
GetTimeZone = 0
Case TIME_ZONE_ID_STANDARD, TIME_ZONE_ID_UNKNOWN
GetTimeZone = (buffer(0) + buffer(21)) / -60
Case TIME_ZONE_ID_DAYLIGHT
GetTimeZone = (buffer(0) + buffer(42)) / -60
Case Else
GetTimeZone = 0
End Select
End Function
(From http://binaryworld.net/Main/CodeDetail.aspx?CodeId=152)

Resources