Lotusscript save base64 encoded string to file (DLL) - vb.net

[EDIT] I believe i left out my original problem. To me it seems like the issue resides in passing the content of the decoded MIMEEntity to a stream, which i'd like to write out to a file. No matter how i attempt it, i can not get lotus script to write the binary data to the file. If anyone has any helpful opinion/suggestion/etc.., I'd be more then grateful!
[ORIGINAL]
I have the following code
Dim a As String
a = "TVqQAAMAAAAEAAAA//8AALgAAAAAAAAAQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA" & _
"AAAAgAAAAA4fug4AtAnNIbgBTM0hVGhpcyBwcm9ncmFtIGNhbm5vdCBiZSBydW4gaW4gRE9TIG1v" & _
...
...
Dim session As New NotesSession
Dim stream As NotesStream
Dim doc As NotesDocument
Dim body As NotesMimeEntity
Dim db As NotesDatabase
Set session = New NotesSession
'Create stream and display properties
Set stream = session.CreateStream
'check if the file exists
If Not stream.Open("C:\\Notes\\update.dll") Then
'if the file doesnot exist then create one and add a time stamp to it
Dim fileNum As Integer
fileNum% = Freefile()
Open "/ww414/notes/ebcdicfile.txt" For Output As fileNum%
Close fileNum%
'this should have created the file. see if it existis now
If Not stream.Open("C:\\Notes\\update.dll") Then
'if the file has not been created yet then let the user know of the error that blocks the operation
Messagebox("Log file Is inaccessible")
End If
End If
Dim b As NotesStream
Set b = session.CreateStream
Call b.WriteText(a)
'==========================================================
'update file with the b64 decoded content
Set db = session.CurrentDatabase
Set doc = db.CreateDocument
session.ConvertMime = False
Set body = doc.CreateMIMEEntity
Call body.SetContentFromText(b, "", ENC_BASE64)
Call body.DecodeContent
content = body.ContentAsText
Call stream.WriteText(content)
'close stream/file open in memory
Call stream.Close()
The problem is, the file gets created, but when it comes to the content, it simply puts a few bytes in it (instead of the 14kb of actual file data)
I have checked a bunch of forums and possible solutions, but none of them seem to work.
For instance:
https://www.nsftools.com/tips/Base64v14.lss
http://www-10.lotus.com/ldd/nd6forum.nsf/e5f5333619f2996885256a220009508f/a8bb2c21c99f9c4d852571ee005cede9?OpenDocument
https://ghads.wordpress.com/2008/10/17/vbscript-readwrite-binary-encodedecode-base64/

So, the solution was even simpler as i thought.
This was a huge help, as the root cause of my issue seemed to be the writing out the binary content to the disk. And that was due to creating the file the wrong way! While the file got created it couldn't output the content properly (for some "Lotus reasons"..)
Either way, taking a coffee break and starting everything from zero helped a lot! The code that worked (for future ref. if someone would need to get such a thing working):
Sub Initialize
Dim a As String
a ="BASE64 ENCODED STRING(In my case it was a DLL)"
Dim session As New NotesSession
Dim stream As NotesStream
Dim doc As NotesDocument
Dim body As NotesMimeEntity
Dim db As NotesDatabase
Set session = New NotesSession
Set stream = session.CreateStream
Dim b As NotesStream
Set b = session.CreateStream
Call b.WriteText(a, EOL_NONE)
Set db = session.CurrentDatabase
Set doc = db.CreateDocument
session.ConvertMime = False
Set mime = doc.CreateMIMEEntity
Call mime.SetContentFromText(b, "application/octet-stream", ENC_BASE64)
Call mime.DecodeContent
If Not(mime Is Nothing) Then
Set stream = session.CreateStream
pathname$ = "c:\temp\test.dll"
If Not stream.Open(pathname$, "binary") Then
Messagebox pathname$,, "Open failed"
Goto ExitSub
End If
Call mime.GetContentAsBytes(stream)
Call stream.Close
Else
Messagebox "Not MIME",, doc.GetItemValue("Subject")(0)
End If
ExitSub:
session.ConvertMIME = True ' Restore conversion
End Sub

Related

Error when downloading file through ADODB stream in VB code

We are getting an error message "Arguments are of the wrong type, are out of acceptable range, or are in conflict with one another" when opening an ADODB stream object for downloading a file automatically on the user's computer. The error is on the line objADOStream.Open and objADOStream.Write .GetReponseBody and we are using the following lines of code:
Private Sub oXMLHTTP_ResponseReady(ByVal ready As Boolean)
On Error GoTo oXMLHTTP_ResponseReady_EH
Call WriteLog("ready:" & ready & ", OutFilePathName:" & OutFilePathName, "oXMLHTTP_ResponseReady")
Dim objADOStream As Object
Dim fs As New FileSystemObject 'comment
If ready Then
With oXMLHTTP
If fs.FileExists(OutFilePathName) = True Then fs.DeleteFile (OutFilePathName)
Set objADOStream = CreateObject("ADODB.Stream")
'timer disable 'timerlastdat
TmrLastDataArrival.Enabled = False 'comment
objADOStream.Open
objADOStream.Type = 1 'adTypeBinary
objADOStream.Write .GetReponseBody
objADOStream.Position = 0 'Set the stream position to the start
objADOStream.SaveToFile OutFilePathName
objADOStream.Close
Set objADOStream = Nothing
End With
bDownloading = False
End If
Set fs = Nothing
Please assist in resolving.
Assuming that oXMLHTTP is an instance of IXMLHTTPRequest, then there is no method or property called GetResponseBody. However, there's a property responseBody.
And as far as I can tell, you simply store the web request's response to disk, for which I think using the ADODB.Stream object is overkill. Why not simply use VB's file handling commands (Open OutFilePathName As #...)? It takes 4 lines of code to do so:
Dim hFile As Long: hFile = FreeFile
Open OutFilePathName For Binary Access Write Shared As #hFile
Put #hFile, , oXMLHTTP.responseBody
Close #hFile

Writeline in VBA breaks with too long text

I am automating a web page extraction and writting the contents to a text (HTML) file.
For that I set up a File System Object like this
Dim myHTMLfilepath As String
myHTMLfilepath = "C:\temp\MyFile.html"
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim myHTMLFile As Object
Set myHTMLFile = fso.createtextfile(myHTMLfilepath)
When I try to write the extracted content to the file sometimes I get an error 5 (invalid parameter). Here is th code:
myHTMLFile.writeline objIE.document.getElementsByClassName("cool-box")(0).innerHTML
It breaks when the length of the innerHTML is somewhere between 25800 and 28000 (I haven't yet figured the exact limit).
Does anyone know if the WriteLine limit can be increased or advise on a different way to do this?
Assuming the .innerHTML can successfully be read into a string (split up reading/writing to find out), you should be able to use an ADODB.Stream to write it to the file. WriteLine is intended to write a single line of text to a file, not a whole entire document.
Dim contents As String
contents = objIE.document.getElementsByClassName("cool-box")(0).innerHTML
With CreateObject("ADODB.Stream")
.Open
.Type = 1
.Write contents
.SaveToFile myHTMLfilepath, 2
.Close
End With

How to call PDPageRelease API to release pdf?

Here is my code.
Public Function GetPDFLastTwentyText(ByVal pstrPdfFilename As String) As String
Dim PDDoc As Object
Dim CAcroRect As New Acrobat.AcroRect
Dim PDPage As Acrobat.AcroPDPage
Dim PDTxtSelect As Acrobat.AcroPDTextSelect
Dim CArcoPoint As Acrobat.AcroPoint
Dim iNumWords As Integer
Dim iMax As Long
Dim arPdfLines() As String
Dim i As Integer
Dim fso As FileSystemObject
GetPDFLastTwentyText = ""
Set fso = New FileSystemObject
If fso.FileExists(pstrPdfFilename) Then
Set PDDoc = CreateObject("AcroExch.PDDoc")
PDDoc.Open pstrPdfFilename
Set PDPage = PDDoc.AcquirePage(PDDoc.GetNumPages() - 1)
Set CArcoPoint = PDPage.GetSize()
CAcroRect.Top = CArcoPoint.y
CAcroRect.Left = 0
CAcroRect.Right = CArcoPoint.x
CAcroRect.bottom = 0
Set PDTxtSelect = PDDoc.CreateTextSelect(PDDoc.GetNumPages() - 1, CAcroRect)
...
PDDoc.Close
End If
Set fso = Nothing
Set PDTxtSelect = Nothing
Set CAcroRect = Nothing
Set CArcoPoint = Nothing
Set PDPage = Nothing
Set PDDoc = Nothing
End Function
I have no idea to use this API.
PDPageRelease()
And Is there official document about this API?
Here is the Description that I find in adobe's API document.
PDPage PDDocAcquirePage(PDDoc doc, ASInt32 pageNum)
Gets a PDPage from
a document. It increments the page's reference count. After you are
done using the page, release it using PDPageRelease(). If
PDPageRelease() is not called, it could block the document containing
the page from being closed. To avoid such problems, use the
CSmartPDPage class, as it ensures that the page is released as it goes
out of scope.
It mention that It should call this API after you call 『AcquirePage』.
Using VBA or other scripting languages you work with OLE Automation. The description you will find "Acrobat Interapplication Communication Reference".
There is no PDPageRelease() element. PDPageRelease() belong to the plugin API. A plugin can only be written in C#.
If you only want to close the document, without closing Acrobat you can use the following code instead of "PDDoc.Close". Br. Reinhard
Set AForm = CreateObject("AFormAut.App") '//connect to Form API
exe = "app.execMenuItem('Close');" '//write js-code to variable
AForm.Fields.ExecuteThisJavaScript exe '//execute js-code

System.__ComObject in LotusNotes in VB.net when extracting Attachments

I want to access a Lotus Notes Database and get attachments from documents in it.
I can open the DB and doc and loop through all items.
The problem is, I can not use the items as NotesRichTextItem and therefore not check if there are any item.EmbeddedObject.
I guess it is a problem with declaration of the items.
In general: If I debug using VS2010, doc and the database and NotesSession have the "value" System.__ComObject and "type" is the Domino.Notes Object it should be.
e.g. doc in WATCH:
Name VALUE TYPE
doc {System.__ComObject} Domino.NotesDocument
but if I use the doc.GetType() command the result is
doc.GetType() = {Name = "__ComObject" FullName = "System.__ComObject"}
Since I do not know if my doc.item is a NotesRichTextItem, I define it as an object and want to check afterwards is type. Which I can't since the return value of the functions is as above for doc, too.
Here is the complete code I use currently, I loaded the Lotus Domino reference from the COM section.
Public Sub OpenDocumentLN()
Try
Dim ns As New Domino.NotesSession
Dim db As Domino.NotesDatabase
Dim doc As Domino.NotesDocument
Dim view As Domino.NotesView
If Not (ns Is Nothing) Then
ns.Initialize()
db = ns.GetDatabase("", sLotusNotesPath & sLotusNotesDB, False)
If Not (db Is Nothing) Then
view = db.GetView(sLotusView)
doc = view.GetFirstDocument
While Not doc Is Nothing
Dim lnNextDoc As Domino.NotesDocument = view.GetNextDocument(doc)
For Each item As Domino.NotesItem In doc.Items
Dim rtItem As Object = doc.GetFirstItem(item.Name)
If rtItem Is Nothing Then Continue For
If Not rtItem.GetType() = GetType(Domino.NotesRichTextItem) Then Continue For
' NEVER reach this part of the code since the IF clause prevents it due to the type problem
If rtItem.EmbeddedObjects Is Nothing Then Continue For
For Each o As Domino.NotesEmbeddedObject In rtItem.EmbeddedObjects
o.ExtractFile(sLotusExportPath & o.Source)
Next
Next
doc = lnNextDoc
End While
End If
db = Nothing
ns = Nothing
End If
Catch ex As Exception
End Try
End Sub
How can I use my rtitem as a NotesRichTextItem so I can handle it appropiate? And why are all objects are treated als ComObjects?

NotesDocument.save() causing loss of rich text formatting

I have following code in an lotusscript agent that removes attachments from NotesDocuments. But NotesDocument.save() causes loss of rich text formatting (font, color). Is there any way to retain the formatting?
Sub removeAttachments_v2(doc As NotesDocument)
Dim session As NotesSession
Dim rtitem As Variant
Dim filename As String
Dim ans As Variant
Set session = New NotesSession
Dim richstyle As NotesRichTextStyle
Set richstyle = session.CreateRichTextStyle
richstyle.NotesColor = COLOR_BLUE
If doc.HasEmbedded Then
Set rtitem = doc.getfirstitem("Body")
If (rtitem.type = RICHTEXT) Then
ForAll object In rtitem.EmbeddedObjects
If (object.Type = EMBED_ATTACHMENT) Then
filename = object.source
Call object.remove
Call rtitem.AddNewLine( 2 )
Call rtitem.AppendStyle(richstyle)
Call rtitem.AppendText( "Attachemnt removed: " & filename )
Call doc.Save( True, True , True )
End If
End ForAll
End If
End If
End sub
Edit1: Initialize function
Sub Initialize
Dim db As New NotesDatabase("","")
Dim col As NotesDocumentCollection
Dim doc As NotesDocument
Call db.Open("", "C:\this\is\db\dir\test.nsf")
Set col = db.Alldocuments
Set doc = col.Getfirstdocument()
While Not ( doc Is Nothing )
Call RemoveAttachments_v2(doc)
Call doc.Save(False, False, False)
Set doc = col.GetNextDocument( doc )
Wend
End Sub
Despite of the fact, that you save the document for every attachment I cannot find any reason, why this should happen. I just copied your code in an agent, and it removes the attachments as desired and appends the text in blue...
No formatting is lost...
The error has to be somewhere else in your code, probably in the calling function.
OLD ANSWER (wrong due to own tests, just kept here as history):
The Problem here most probably is: you defined rtitem as Variant. And
getfirstitem gets you a NotesItem instead of a NotesRichtextItem, so
when saving, it is converted to a "plain Text" item.
Most probably you used Variant instead of NotesRichtextItem, because
there are Mime- mails where defining the variable as NotesRichtextItem
will cause an "Type Missmatch" or similar error. As long as you do not
write anything back this is OK.
As Mime Mails need complete different handling to achieve your goal,
you should first fix the code for pure NotesRichtextItems by using the
right type, and then write another code- branch for handling Mime-
items