Showing posts with label lotus script. Show all posts
Showing posts with label lotus script. Show all posts

Monday, September 25, 2023

Change Database ReplicaID programmatically

Here is a solution that change ReplicaId of NotesDatabase. Since native capabilities of LotusScript/Java classes do not allow such operation (at least yet), there is a way to do it using C Notes API. Our envrionment consists of both: Windows and Linux servers therefore I had to make a solution that cover both OS.

Declare

Public Const W32_LIB = {nnotes.dll}
Public Const LINUX_LIB = {libnotes.so}

Type TIMEDATE
	Innards(0 to 1) As Long
End Type

Type DBREPLICAINFO
	ID As TIMEDATE			'ID that is same for all replica files
	Flags As Integer		'Replication flags
	CutoffInterval As Integer	'Automatic Replication Cutoff
	Cutoff As TIMEDATE		'Replication cutoff date
End Type

Declare sub W32_OSCurrentTimeDate Lib W32_LIB Alias "OSCurrentTIMEDATE"(Ret As TIMEDATE)
Declare Function W32_NSFDbOpen Lib W32_LIB Alias "NSFDbOpen" (ByVal dbName As String, hdb As Long) As Integer
Declare Function W32_NSFDbClose Lib W32_LIB Alias "NSFDbClose" (ByVal hdb As Long) As Integer
Declare Function W32_NSFDbReplicaInfoGet Lib W32_LIB Alias "NSFDbReplicaInfoGet" (ByVal hdb As Long, hdbr As DBREPLICAINFO) As Integer
Declare Function W32_NSFDbReplicaInfoSet Lib W32_LIB Alias "NSFDbReplicaInfoSet" (ByVal hdb As Long, hdbr As DBREPLICAINFO) As Integer

Declare Sub LINUX_OSCurrentTimeDate Lib LINUX_LIB Alias "OSCurrentTIMEDATE"(Ret As TIMEDATE)
Declare Function LINUX_NSFDbOpen Lib LINUX_LIB Alias "NSFDbOpen" (ByVal dbName As String, hdb As Long) As Integer
Declare Function LINUX_NSFDbClose Lib LINUX_LIB Alias "NSFDbClose" (ByVal hdb As Long) As Integer
Declare Function LINUX_NSFDbReplicaInfoGet Lib LINUX_LIB Alias "NSFDbReplicaInfoGet" (ByVal hdb As Long, hdbr As DBREPLICAINFO) As Integer
Declare Function LINUX_NSFDbReplicaInfoSet Lib LINUX_LIB Alias "NSFDbReplicaInfoSet" (ByVal hdb As Long, hdbr As DBREPLICAINFO) As Integer

Code C API (main part of it)

'GET CURRENT TIMEDATE (TO BUILD NEW REPLICAID): OSCurrentTimeDate
If IS_WINDOWS Then
	Call W32_OSCurrentTimeDate(ReplicaID)
Else
	Call LINUX_OSCurrentTimeDate(ReplicaID)
End If
ReplicaInfo.ID = ReplicaID
	
'SET NEW REPLICAID: NSFDbReplicaInfoSet
If IS_WINDOWS Then
	rc = W32_NSFDbReplicaInfoSet(hDb, replicaInfo)
Else
	rc = LINUX_NSFDbReplicaInfoSet(hDb, replicaInfo)
End If

You can find all solution on GitHub: DominoChangeDatabaseReplicaID

Friday, November 12, 2021

Clear database replication history programatically

Recently I had a need to make a solution that can periodically clean replication history for list of databases.

Native LotusScript/Java classes do not allow that, but there is an C API for that.

Here is a cross platform solution (works for Windows/Linux)

Declare

Public Const W32_LIB = {nnotes.dll}
Public Const LINUX_LIB = {libnotes.so}

Declare Function W32_NSFDbOpen Lib W32_LIB Alias {NSFDbOpen} (ByVal dbName As String, hDb As Long) As Integer
Declare Function W32_NSFDbClose Lib W32_LIB Alias {NSFDbClose} (ByVal hDb As Long) As Integer
Declare Function W32_NSFDbClearReplHistory Lib W32_LIB Alias {NSFDbClearReplHistory} (ByVal hDb As Long, flags As Integer) As Integer

Declare Function LINUX_NSFDbOpen Lib LINUX_LIB Alias {NSFDbOpen} (ByVal dbName As String, hDb As Long) As Integer
Declare Function LINUX_NSFDbClose Lib LINUX_LIB Alias {NSFDbClose} (ByVal hDb As Long) As Integer
Declare Function LINUX_NSFDbClearReplHistory Lib LINUX_LIB Alias {NSFDbClearReplHistory} (ByVal hDb As Long, flags As Integer) As Integer

Using C API functions

// get a handler to database
If IS_WINDOWS Then
	rc = W32_NSFDbOpen(Server & "!!" & FileName, hDb)
Else
	rc = LINUX_NSFDbOpen(Server & "!!" & FileName, hDb)
End If

// clear replication history
If IS_WINDOWS Then
	rc = W32_NSFDbClearReplHistory(hDb, 0)
Else
	rc = LINUX_NSFDbClearReplHistory(hDb, 0)
End If

// close datababase (be sure you always close hDb if you opened it, otherwise memory leak).
If IS_WINDOWS Then
	rc = W32_NSFDbClose(hDb)
Else
	rc = LINUX_NSFDbClose(hDb)
End If

Be sure that you always close hDb handler if you opened the database, otherwise it would lead to memory leak)

See the full solution on GitHub: DominoReplicationHistoryCleaner

Thursday, April 08, 2021

Checking if database is encrypted with LotusScript (C API)

Since it's not possible to identify encryption status and level using native LotusScript/Java classes here is a way to do that. The solution is based on Notes CAPI (within LotusScript) but it works for both Linux/Windows environment.

I will omit NSFDbOpen and NSFDbClose since it's easy to find out and focus instead on the main function: NSFDbLocalSecInfoGetLocal.

Declaration

Const NNOTES ="nnotes.dll"
Const LIBNOTES ="libnotes.so"

Declare Public Function WIN_NSFDbLocalSecInfoGetLocal Lib NNOTES Alias "NSFDbLocalSecInfoGetLocal"(ByVal hDb As Long, state As Long, strength As Long) As Integer
Declare Public Function LIN_NSFDbLocalSecInfoGetLocal Lib LIBNOTES Alias "NSFDbLocalSecInfoGetLocal"(ByVal hDb As Long, state As Long, strength As Long) As integer

Function check encryption status

public Function NSFDbLocalSecInfoGetLocal(hDB As Long, state As Long, strength As long) As Integer
 If isDefined("WINDOWS") Then
  NSFDbLocalSecInfoGetLocal = WIN_NSFDbLocalSecInfoGetLocal(hDb, state, strength)
 ElseIf isDefined("LINUX") Then
  NSFDbLocalSecInfoGetLocal = LIN_NSFDbLocalSecInfoGetLocal(hDb, state, strength)
 End If
End Function

Example how to use it

Private Function calcEncryption(database As NotesDatabase, doc As notesdocument)
 Dim sDb As String
 Dim hDb As Long
 Dim state As Long
 Dim encrypt As Long
 Dim rc As Integer

 sDb = database.server & "!!" & database.filepath

 rc = NSFDbOpen(sDb, hDb)
 If rc <> 0 Then Exit function

 rc = NSFDbLocalSecInfoGetLocal(hDB, state, encrypt)
 If rc <> 0 Then
  Error 9001, "Impossible to read encryption. Error code: " & CStr(rc)
 End If

 rc = NSFDbClose(hDb)
End Function
  • state: 0 (not encrypted), 1 (encrypted) or 2 (will be encrypted after compact)
  • encrypt: 1 (easy), 2 (middle), 3 (strong)

Wednesday, January 20, 2021

How to post attachments using form to agent

I have a form with some text fields and I also needed to send attachments within same form.

Form is printed by agent and is processed by another agent written in LotusScript.

I spent some time working on solution and here it is.

The idea is to convert selected files to base64 on client side and then post data on submission and agent that process submission will conver base64 to file.

Here is a form, note that we run some logic when files are added

<form name="formName" method="post" action="agentName?openagent">
<input name="title" value="xxx">
<input type="file" name="files" multiple onchange="toBase64()">
</form>

Here is how we convert selected files to base64 and how we results as text fields to form (JS is not optimal, it can be done without jQuery)

function toBase64() {
  var files = document.querySelector('input[type=file]').files;

  var form = $("form");
  form.find("input[name^='filebase64']").remove(); // replace

  function readAndSave(file, index) {
    var reader = new FileReader();
	
    reader.addEventListener("load", function() {
      form.append("");
      form.append("");
    }, false);

    reader.readAsDataURL(file);
  }

  if (files) {
    [].forEach.call(files, readAndSave);
  }
}

Once form is submitted we have to read base64 items and convert them to file. There are at least 2 solutions: pure LS or Java/LS2J

a) LotusScript using NotesMIMEHeader
Private Function saveBase64AsFile(base64 As String, filePath As string) As Boolean
	On Error GoTo ErrorHandler

	Dim stub As NotesDocument
	Dim stream As NotesStream
	Dim item As NotesMIMEEntity
	Dim header As NotesMIMEHeader
	Dim emb As NotesEmbeddedObject
	Dim fileName As String
	Dim contentType As string
	Dim base64File As String

	fileName = StrRightBack(filePath, "\")
	contentType = StrRight(Strleft(base64, ";"), ":")
	base64File = StrRight(Base64, ",")
	
	Call scriptLog.loginfo(fileName)
	Call scriptLog.loginfo(contentType)
	
	Set stub = db.Createdocument()
	Set item = stub.CreateMIMEEntity("Body")
	Set header = item.createHeader("Content-Disposition")
	Call header.setHeaderVal({attachment; filename="} & fileName & {"})

	Set stream = app.NotesSession.CreateStream()
	Call stream.WriteText(base64File)
	Call item.SetContentFromText(stream, contentType, ENC_BASE64)

	Call stream.Truncate
	Call stream.Close
	Call stub.Closemimeentities(True)

	Set emb = stub.Getattachment(fileName)
	Call emb.Extractfile(filePath)
	
	Exit Function
ErrorHandler:
	Error Err, Error
End Function
b) Java with LS2J using native classses.
import java.util.Base64;
import java.io.IOException;
import java.nio.file.*;

public class Base64ToFile{

	public boolean convert(String base64String, String filePath) {
		try {
			byte[] decodedImg = Base64.getDecoder().decode(base64String.getBytes());
			Path destinationFile = Paths.get(filePath);
			Files.write(destinationFile, decodedImg);
			return true;
		} catch (IOException e) {
			e.printStackTrace();
		}
		return false;
	}
}
UseLSX "*javacon"
Use "Base64ToFile"

Class Base64ToFile
	Private jSession As JavaSession
	Private jClass As Javaclass
	Private jObject As JavaObject
	Private jError As JavaError
	
	Sub New()
		Set jSession = New JavaSession
		Set jClass = jSession.GetClass("Base64ToFile")
		Set jObject = jClass.Createobject()
	End Sub
	
	Public Function convert(base64 As String, filePath As String) As Boolean
		convert = jObject.convert(base64, filePath)
	End Function
End Class

Tuesday, May 05, 2015

ColumnValuesIndex property of NotesViewColumn

Since there is no documentation about property ColumnValuesIndex of class NotesViewColumn. Let me describe it.
Let's create a view with 7 columns:
  1. @DocNumber
  2. Hidden (sorting) column that does sorting
  3. Column with formula value: Form
  4. Icon (static value: 12)
  5. Column with formula value: @Created
  6. Constant value: 100
  7. Total with 'hide details row' enabled (for each row value: 1)

Analyze ColumnValuesIndex

Let's write some code and check what exactly ColumnValuesIndex returns
  Dim ws As New NotesUIWorkspace
  Dim view As NotesView
  Dim col As NotesViewColumn
  Dim i As Integer
 
  Set view = ws.CurrentView.View
  For i = 0 To view.ColumnCount - 1
    Set col = view.Columns(i)
    Msgbox col.ColumnValuesIndex
  Next
The result for columns will be: -1, 0, 1, -1, 2, -1, 3.
We may see now that for some of columns we got (-1). Let's look on these 3 columns and try to guess how they are different compare to other columns. Here is my assumptions for what cases it returns (-1)
  • A formula containing a UI-only function such as @IsExpandable or @DocNumber.
  • A constant.

Summary for ColumnValuesIndex

Otherwise it returns columns position (without taking into account columns with -1), It looks like it is exactly same logic as in notesViewEntry.ColumnValues

Monday, May 04, 2015

Refresh embedded view

Here is the classic old issue. I've a form with embedded view on it (Show single category is used as well). There is an action on a view that create a new documents (which should be displayed in that embedded view). These solutions most likely wont work
  • ws.ViewRefresh will not help
  • Refreshing NotesUIDocument may cause a Notes client to crash, so it is not a way to go as well.
Here are some possible ways to solve it:

Refresh view by simulating of pressing F9

While searching for an example I found it on my blog :-), so you can easily find it here: how to emulate F9 key and save some minutes.

Refresh view by changing focus to another fields

The idea is to have 2 fields (let's call them FieldA and fieldB). Once you need to refresh embedded view - set focus to fieldA and then change it to fieldB. You also need either add refresh logic on Exiting property of fieldA (I prefer it, as it will not cause the perfomance on a form) or enable Automatically Refresh fields.

Refresh embedded view using hidden formula

Here the idea is to make sure we have hidden formula on Embedded View (even such like 1 = 0) and use Refresh
And here is code examples
  Call ws.ViewRefresh
  Call uidoc.RefreshHideFormulas
  Call ws.ViewRefresh

Please have a look on these 2 articles that inspired me:
  1. Refreshing an embedded view
  2. How to refresh NotesUIDocument from categorized embedded view

Wednesday, June 13, 2012

Cool trick which I never saw in LotusScript. Pass function as parameter.

Read this code
'Comments for SetValue
Sub SetValue(src As Variant, target As Variant)
 If IsObject(src) Then
  Set target = src
 Else
  target = src
 End If
End Sub

'Comments for Test
Function Test(value As Variant) As Variant
 SetValue value, Test
End Function
You can call Test(now) or Test(customobject) or Test("ABC") it will return you just same object/value. nice, isn't it?
msgbox Test(now).DateOnly
msgbox Test("Helllo")
msgbox Test(customobject).customProperty
Do not see right now really huge benefits from this but just nice to know this.

Monday, March 29, 2010

RefreshDesign of NotesDatabase using NotesAPI

Here is an example how we can do refresh design using NotesAPI.

I'm really interesting in approach without NotesAPI, but did not find any good. If somebody know better approach, please share it :)
 Function RefreshDesign(sourceDb As NotesDatabase, refreshServer As string)  
 Dim destPath As String  
 Dim rc As Integer  
 Dim hDb As Integer  
 If sourceDb.Isopen Then  
 'sourceDb could be local or server  
 If sourceDb.server = "" Then  
 destPath = sourceDb.filePath  
 Else  
 destPath = sourceDb.server & "!!" & sourceDb.filePath  
 End If  
 ' Open the db in the API and get a handle to the open db  
 rc = W32_NSFDbOpen(destPath, hDb)  
 ' Return zero on success, non-zero on failure  
 If rc = 0 Then  
 rc = W32_DesignRefresh(refreshServer, hDb, 0, 0, 0)  
 Call W32_NSFDbClose(hDb)  
 End If  
 End If  
 End Function  

Sunday, December 06, 2009

check if Bookmark or Name is exists in Word/Excel application

I did not have tasks with export data from LN to word/excel/pdf for 1 years probably. My today's task was easy, I had to export data from LN to xml, processed it using xsl, walk through resulting xml and export everything to word/excel. Then I had to copy values from resulting xml to word/excel's temlpate using bookmarks (in excel it is names).

Here is an example how to check bookrmark/names in word/excel (because before I did not have experience with Excel's names)

excel approach I got from this link

Function NameExists(TheName
as String, obj, formType as String) As Boolean

NameExists = False

Select Case formType
Case "word":
if obj.activedocument.Bookmarks.Exists(TheName) Then
NameExists = true
End If
Case "excel"
On Error Resume Next
NameExists = Len(obj.names(TheName).Name) <> 0
End Select

End Function

Friday, December 04, 2009

How to emulate F9 key

Sometimes F9 makes good staff for us, so here is an example (I really don't remember where I got it).

'F9
Declare Function VkKeyScan Lib "User32.dll" Alias "VkKeyScanA" ( Byval char As Integer ) As Integer
Declare Function MapVirtualKey Lib "User32.dll" Alias "MapVirtualKeyA" ( Byval wCode As Long, Byval wMapType As Long ) As Long
Declare Sub keybd_event Lib "User32.dll" ( Byval Virtual As Integer, Byval OEMScan As Integer, Byval Flags As Long, Byval ExtrInfo As Long )
Const KE_KEYDOWN& = 0
Const KE_KEYUP& = 2 

Sub F9
  On Error Goto errorproc

  Dim vk As Long
  Dim sc As Integer

  vk = &H78

  sc = Cint( MapVirtualKey( vk&, 0 ) )

  Call keybd_event( Cint( vk& ), sc%, KE_KEYDOWN&, 0 )
  Yield
  Call keybd_event( Cint( vk& ), sc%, KE_KEYUP&, 0 )
  Yield

  endofsub:
    Exit Sub
  errorproc:
    Msgbox "Error #" & Err & " on line " & Erl & " in function " & Lsi_info(2) & " : " & Error, 48, "Runtime error"
  Resume endofsub 
End Sub

Tuesday, July 14, 2009

How to kill process from LN

I found this approach as very good for my purposes. It works at least . I suppose that there are another couple even better approach, so if you know them share please.

Type PROCESSENTRY32

dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwFlags As Long
szexeFile As String * 260
End Type
'-------------------------------------------------------
Declare Function OpenProcess Lib "kernel32.dll" (Byval dwDesiredAccess As Long, Byval blnheritHandle As Long, Byval dwAppProcessId As Long) As Long
Declare Function ProcessFirst Lib "kernel32.dll" Alias "Process32First" (Byval hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Declare Function ProcessNext Lib "kernel32.dll" Alias "Process32Next" (Byval hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Declare Function CreateToolhelpSnapshot Lib "kernel32.dll" Alias "CreateToolhelp32Snapshot" (Byval lFlags As Long, lProcessID As Long) As Long
Declare Function TerminateProcess Lib "kernel32.dll" (Byval ApphProcess As Long, Byval uExitCode As Long) As Long
Declare Function CloseHandle Lib "kernel32.dll" (Byval hObject As Long) As Long


Public Sub KillProcess(NameProcess As String)
Const PROCESS_ALL_ACCESS = &H1F0FFF
Const TH32CS_SNAPPROCESS = 2&
Dim uProcess As PROCESSENTRY32
Dim RProcessFound As Long
Dim hSnapshot As Long
Dim SzExename As String
Dim ExitCode As Long
Dim MyProcess As Long
Dim AppKill As Boolean
Dim AppCount As Integer
Dim i As Integer
Dim WinDirEnv As String

If NameProcess <> "" Then
AppCount = 0

uProcess.dwSize = Len(uProcess)
hSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)
RProcessFound = ProcessFirst(hSnapshot, uProcess)

Do
i = Instr(1, uProcess.szexeFile, Chr(0))
SzExename = Lcase$(Left$(uProcess.szexeFile, i - 1))
WinDirEnv = Environ("Windir") + "\"
WinDirEnv = Lcase$(WinDirEnv)

If Right$(SzExename, Len(NameProcess)) = Lcase$(NameProcess) Then
AppCount = AppCount + 1
MyProcess = OpenProcess(PROCESS_ALL_ACCESS, False, uProcess.th32ProcessID)
AppKill = TerminateProcess(MyProcess, ExitCode)
Call CloseHandle(MyProcess)
End If
RProcessFound = ProcessNext(hSnapshot, uProcess)
Loop While RProcessFound
Call CloseHandle(hSnapshot)
End If
End Sub

Thursday, February 12, 2009

overload of methods/functions in Lotus Script

I make overload for any methods/functions using next approach. It is quite simple and useful from my point of view

Sub new(key As Variant)
Select Case Typename(key)
Case "STRING":
call newForString(key) or do code
Case "NOTESDOCUMENT
call newForNotesDocument(key) or do code
Case "EMPTY
call newForEmpty(key) or do code
End Select

Wednesday, February 11, 2009

how we can check LIST for empty

Today I was faced with small issue, I realised that I don't know how to check LIST variable for empty. Really, I was so confused. I've done it using next approach, but to be honest I don't like it. If anybody knows better approch, please share it here!
...
isValid = False
Forall x In myList
isValid = True
Exit Forall
End Forall
...

Saturday, December 20, 2008

Debug Lotus Notes applications

I would like to present which approaches I use during debugging LN applications. I would be happy if anybody add new interesting approaches.

[@Formula]

- @Prompt and @StatusBar – the easiest way to debug code written on @Formula
- Field Debug_Fld := value_debug
- @MailSend – for code that runs on server (sch. agents)
- notes.ini - I don't like this approach because of size of variables

Example
strA := "ABC"; strB := "DEF";
strC := strA + strB;
@Prompt([ok]; "strC";"strC = " + strC);
@StatusBar("strC = " + strC);
Field Debug_FieldName := strC;
@MailSend("username";"";""; "debug strC"; ""; "strC = " + strC);

[Lotus Script]
- Lotus Script Debugger as tool for debugging
- Print, MsgBox, NotesLog, Stop, on erorr goto errh

Example
Dim strA As String
Dim strB As String
Dim strC As String
strA = "ABC"
strB = "DEF"
strC = strA & strB
Print "strC = " & strC
Msgbox "strC = " & strC
Stop 'enable debugger require
Dim currentLog As New NotesLog( “debug log 1" )
Call currentLog.OpenFileLog( "c:\log.txt" )

Call currentLog.LogAction( "strC = " & strC)
Call currentLog.Close

[Schedule Agents]

- remote debugger (it is easy to enable it if you read help)
- send an email, msgbox (log.nsf), noteslog

[JavaScript]
- alert(value);
- try – catch();
- Microsoft script debugger \ Mozilla firebug \ Chrom debugger

Lets catch the next simple error

Example
code on the button use call function add, the body of function below
function add(frm){
var i1 = frm.Number1.value;
var i2 = frm.Number2.value;
var fld = frm.total;
fld.value = i1 + i2;
}

when we call function we will see next error:
what it could be? it does not provide us enough information (I think so). Now enable ie debugger
click Yes
Now we see where is error, but still could not understand "why?"
Now we are definitely close to solve the problem, we see that we did not take "number" field. Why we did not take number field? yes because of small first letter. We should wrote Number but not number.

[Java]
- Java debug console (System.out.println(“text”);
- Try / catch with NotesError and NotesException classes
- Remote java debugging with Eclipse

also I would like to recomend you external LN application
openlog.nsf

Wednesday, December 10, 2008

Difference between call of Sub/Functional

Actually I was surprised today when I saw this, please check both scenarios:
In one scenario Call addone(i) it transmit I as reference in another one addone(i) - ByVal

Sub Click(Source As Button)
Dim i As Integer
Dim j As Integer
i = 1
For j = 0 To 10
Call addone(i) | addone(i)
Next

Print "i = " & i
End Sub

Sub addone(i As Integer)
i = i + 1
End Sub

Wednesday, October 22, 2008

edit attachment via LS

I don't know good solution for this task, so it would be cool if somebody share better way then this one.
So if you want to emulate editing of attachments via backend you can do next:
1. make edit button,.
- this button "Open attachment" should export attachment to disk and remember/save the path to the file somewhere.
Dim w As New NotesUIWorkspace
Dim s As New NotesSession
Dim doc As NotesDocument
Dim rtitem As NotesRichTextItem
Dim filename As String

Set doc = w.CurrentDocument.Document
Set rtitem = doc.GetFirstItem("Body")

If doc.HasEmbedded Then
Forall o In rtitem.EmbeddedObjects
filename = "c:\" & o.name
Call o.ExtractFile (filename)
Call doc.ReplaceItemValue("filename", filename)

Call ShellExecute(0, "Open", fileName,"", "C:\", 1)
End Forall
End If


than step #2
you should make some changes and save attachments

step #3
now we have to click on Import button, this button should remove old attachment and import new one. Something like this
Dim w As New NotesUIWorkspace
Dim s As New NotesSession
Dim doc As NotesDocument
Dim rtitem As NotesRichTextItem
Dim filename As String

Set doc = w.CurrentDocument.Document
Set rtitem = doc.GetFirstItem("Body")

If doc.HasEmbedded Then
Forall o In rtitem.EmbeddedObjects
filename = "c:\" & o.name
Call o.Remove()
Call rtitem.EmbedObject(EMBED_ATTACHMENT, "", doc.GetItemValue("filename")(0))
End Forall
End If
Call doc.ReplaceItemValue("filename", "")
Call doc.Save(True, True)

But if you read comments you will see much better solution, I should say that it is really good way to solve this task.

Monday, October 06, 2008

FTSearch on empty field

I'm facing with problem where I should get collection of documents with empty field. It means that query should look like this
set col = db.FTSearch({[myField] = ""}, 0)
We know that it does not work at all, but there is a trick
set col = db.FTSearch({not [myField] is present}, 0)

Thursday, September 25, 2008

get user name from id file

Lets think, if you should receive a name from user.id. Which approach did you choose? I made it using next function. Would be great if somebody share another approach. I think it is possible to use Notes API approach...

Dim s As New NotesSession
Dim stream As NotesStream

Dim body As Variant
Dim pathname As String
Dim strBody As String

pathname = "c:\user.id"

Set stream = s.CreateStream

If Not stream.Open(pathname, "ASCII") Then
Messagebox pathname,, "Open failed"
Exit Sub
End If
If stream.Bytes = 0 Then
Messagebox pathname,, "File has no content"
Exit Sub
End If

body = stream.Read(stream.Bytes)
Call stream.Close

Forall x In body
If x <> 0 Then
strBody = strBody & Chr(x)
End If
End Forall

Msgbox Strleft(Strrightback(strBody, "CN="), "/")

Thursday, August 14, 2008

Copy to Clipboard using LS

Today I had a task, where I should copy value to Clipboard. I found solutions , probably it helps to somebody.

Declare Private Function W32GetActiveWindow Lib "user32" Alias "GetActiveWindow" () As Long
Declare Private Function W32OpenClipboard Lib "user32" Alias "OpenClipboard" ( Byval hWnd As Long ) As Long
Declare Private Function W32CloseClipboard Lib "user32" Alias "CloseClipboard" ( ) As Long
Declare Private Function W32EmptyClipboard Lib "user32" Alias "EmptyClipboard" ( ) As Long
Declare Private Function W32GetClipboardData Lib "user32" Alias "GetClipboardData" ( Byval wFormat As Long ) As Long
Declare Private Function W32SetClipboardData Lib "user32" Alias "SetClipboardData" ( Byval wFormat As Long, Byval hMem As Long ) As Long
Declare Private Function W32IsClipboardFormatAvailable Lib "user32" Alias "IsClipboardFormatAvailable" ( Byval wFormat As Long ) As Long
Declare Private Function W32GlobalLock Lib "kernel32" Alias "GlobalLock" ( Byval hMem As Long ) As Long
Declare Private Function W32GlobalUnlock Lib "kernel32" Alias "GlobalUnlock" ( Byval hMem As Long ) As Long
Declare Private Function W32GlobalAllocate Lib "kernel32" Alias "GlobalAlloc" ( Byval wFlags As Long, Byval dwBytes As Long ) As Long
Declare Private Function W32WriteMemoryToString Lib "kernel32" Alias "lstrcpyA" ( Byval lpString1 As String, Byval lpString2 As Any ) As Long
Declare Private Function W32WriteStringToMemory Lib "kernel32" Alias "lstrcpyA" ( Byval lpString1 As Long, Byval lpString2 As String ) As Long

Function setClipboardText(pstrText As String) As Boolean

'// +++ GLOBAL VARIABLES +++
'// Constants:
'// {record any global constants here}
'//
'// Class instances:
'// {record any global class intances here}
'//
'// Primitives:
'// {record any global primitives here}
'//
'// 05/21/2004 - Dallas Gimpel
'//
'// DESCRIPTION:
'// This function attempts to programmatically copy the text passed in to the Windows
'// clipboard (if it can be opened).
'//
'// NOTE:
'// This code is obviously Win/32 specific.
'//
'// INPUT:
'// pstrText - String, text to be copied to the Windows clipboard
'//
'// OUTPUT:
'// Function returns true if text can be successfully copied to the clipboard

On Error Goto errorHandler

'// one of the "standard clipboard formats"
Const CF_TEXT = 1
'// global memory flags
Const GMEM_FIXED& = &H0
Const GMEM_MOVEABLE& = &H2
Const GMEM_NOCOMPACT& = &H10
Const GMEM_NODISCARD& = &H20
Const GMEM_ZEROINIT& = &H40
Const GMEM_MODIFY& = &H80
Const GMEM_DISCARDABLE& = &H100
Const GMEM_NOT_BANKED& = &H1000
Const GMEM_SHARE& = &H2000
Const GMEM_DDESHARE& = &H2000
Const GMEM_NOTIFY& = &H4000
Const GMEM_LOWER& = GMEM_NOT_BANKED
Const GMEM_VALID_FLAGS& = &H7F72
Const GMEM_INVALID_HANDLE& = &H8000
Const GHND& = (GMEM_MOVEABLE Or GMEM_ZEROINIT)
Const GPTR& = (GMEM_FIXED Or GMEM_ZEROINIT)
Dim lngHWnd As Long
Dim lngCBStatus As Long
Dim lngHGMem As Long
Dim lngGMemPointer As Long
Dim lngSize As Long
Dim lngRC As Long

setClipboardText = False

'// Get a handle to the current window.
lngHWnd& = W32GetActiveWindow()

'// Determine the size required.
lngSize& = Clng(Len(pstrText$) + 1)

'// Attempt to obtain a memory handle.
lngHGMem& = W32GlobalAllocate(GPTR&, lngSize&)
If lngHGMem& = 0 Then
Msgbox "An error was encountered while attempting to obtain a global memory handle.", , "Error encountered . . ."
Goto functionExit
End If

'// Attempt to lock the memory handle and store a pointer to it.
lngGMemPointer& = W32GlobalLock(lngHGMem&)
If lngGMemPointer& = 0 Then
Msgbox "Failed to lock the memory to which the text is to be copied - unable to continue.", , "Error encountered . . ."
Goto functionExit
End If

'// Copy the string passed into the memory allocated.
lngRC& = W32WriteStringToMemory(lngGMemPointer&, pstrText$)

'// Release the memory.
Call W32GlobalUnlock(lngHGMem&)

'// Attempt to open the clipboard.
lngCBStatus& = W32OpenClipboard(lngHWnd&)
If lngCBStatus& = 0 Then
Msgbox {Could not access the "clipboard" - another application may have it locked.}, , "Error encountered . . ."
Goto functionExit
End If

'// Always empty the clipboard first.
lngRC& = W32EmptyClipboard()

'// Now attempt to copy the text to the clipboard.
lngRC& = W32SetClipboardData(CF_TEXT, lngHGMem&)

'// Check to see if the text is there.
lngRC& = W32IsClipboardFormatAvailable(CF_TEXT)
If lngRC& = 0 Then
Msgbox "An error was encountered while attempting to copy the specified text to the clipboard.", , "Error encountered . . ."
Else
setClipboardText = True
End If

functionExit:
'// Always make sure to close the clipboard (even in the event of an error).
If Not(lngCBStatus& = 0) Then
Call W32CloseClipboard()
lngCBStatus& = 0
End If
Exit Function

errorHandler:
Msgbox "Error " & Err & ": " & Error$ & " encountered at line " & Erl & " of " & Getthreadinfo(1) & ".", , "Error encountered . . ."
Print "Error " & Err & ": " & Error$ & " encountered at line " & Erl & " of " & Getthreadinfo(1) & " . . ."
Resume functionExit
End Function
------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
'// W32 API declares
Function getClipBoardText(pblnClearClipboard As Boolean, pstrTextOut As String) As Boolean
'// +++ GLOBAL VARIABLES +++
'// Constants:
'// {record any global constants here}
'//
'// Class instances:
'// {record any global class intances here}
'//
'// Primitives:
'// {record any global primitives here}
'//
'// 05/21/2004 - Dallas Gimpel
'//
'// DESCRIPTION:
'// This function attempts to programmatically open the Windows clipboard and write the
'// text held in memory (if any exists) to the output parameter.
'//
'// Notes from MSDN on the "CF_TEXT" standard clipboard format . . .
'// "Text format. Each line ends with a carriage return/linefeed (CR-LF) combination. A
'// null character signals the end of the data. Use this format for ANSI text."
'//
'// NOTE:
'// This code is obviously Win/32 specific.
'//
'// INPUT:
'// pblnClearClipboard - Boolean, flag indicating whether or not to clear the clipboard
'//
'// OUTPUT:
'// pstrTextOut - String, receives text (if any can be retrieved) held in the clipboard
'// Function returns true if text can be successfully retrieved from the clipboard

On Error Goto errorHandler

Const CF_TEXT = 1 '// one of the "standard clipboard formats"
Const MAXSIZE = 4096
Dim lngRC As Long
Dim lngCBStatus As Long
Dim lngHCBMemory As Long
Dim lngGMemPointer As Long
Dim strBuff As String * MAXSIZE

getClipBoardText = False

'// Attempt to open the clipboard.
lngCBStatus& = W32OpenClipboard(0&)
If lngCBStatus& = 0 Then
Msgbox {Unable to access the text in memory (i.e., contents of the "clipboard") - another application may have it locked.}, , "Error encountered . . ."
Goto functionExit
End If

'// Attempt to get a handle to the text currently held in the clipboard.
lngHCBMemory& = W32GetClipboardData(CF_TEXT)
If lngHCBMemory& = 0 Then
Msgbox {There is no text available in memory (i.e., copied to the "clipboard") - unable to continue.}, , "No text available . . ."
Goto functionExit
End If

'// Attempt to lock the memory and store a pointer to it.
lngGMemPointer& = W32GlobalLock(lngHCBMemory&)
If lngGMemPointer& = 0 Then '// no text in memory - close clipboard & exit
Msgbox "Failed to lock the memory from which the text is to be copied - unable to continue.", , "Error encountered . . ."
Goto functionExit
End If

'// Copy the in-memory string (by pointer location) into the buffer.
strBuff$ = Space$(MAXSIZE)
lngRC& = W32WriteMemoryToString(strBuff$, lngGMemPointer&)
If lngRC& = 0 Then '// an error has occurred in the copy operation
Msgbox "An error was encountered while attempting to copy the string from memory - unable to continue.", , "Error encountered . . ."
Else
strBuff$ = Mid(strBuff$, 1, Instr(1, strBuff$, Chr$(0), 0) - 1) '// remove the null terminator
pstrTextOut$ = Trim(strBuff$) '// clean up the string
If pblnClearClipboard Then
Call W32EmptyClipboard() '// clear contents of the clipboard
End If
getClipBoardText = True
End If
lngRC& = W32GlobalUnlock(lngHCBMemory&) '// release lock on the memory

functionExit:
'// Always make sure to close the clipboard (even in the event of an error).
If Not(lngCBStatus& = 0) Then
Call W32CloseClipboard()
lngCBStatus& = 0
End If
Exit Function

errorHandler:
Msgbox "Error " & Err & ": " & Error$ & " encountered at line " & Erl & " of " & Getthreadinfo(1) & ".", , "Error encountered . . ."
Print "Error " & Err & ": " & Error$ & " encountered at line " & Erl & " of " & Getthreadinfo(1) & " . . ."
Resume functionExit
End Function


original post here

Tuesday, July 22, 2008

How to initialize NotesDocumentCollection in zero

Sometimes I have tasks where I should start to work with empty collection of documents. One of my fellow shown me yesterday probably the simplest solutions how we can got empty collection.

Set notesDocumentCollection = notesDatabase.GetProfileDocCollection("WRONG_NAME")


I like this solution and as I see it is perhaps the best one.

p.s. if anybody has better solution I would be happy to see it.