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)