Option Public Option Declare ' 7.02 includes file resource manipulation s_CreateFileResourceFromView_6_01 '################################################################ ' code courtesy of Rock Oliver / Andre Gruiard ' http://www.lotusgeek.com/SapphireOak/LotusGeekBlog.nsf/D6Plinks/ROLR-6MBMQJ '################################################################ ' Sean Cull ' this was added to allow us to get a handle on the Program directory if running on the client ' as the notes ini notesprogram only exists on servers '################################################################ Declare Function OSGetExecutableDirectory Lib "NNOTES.DLL" Alias "OSGetExecutableDirectory" (_ Byval DirName As String, Byval Size As Long) As Long '################################################################ 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX '################################################################ ' code published by Julian Robichaux. ' http://www.openntf.org/Projects/codebin/codebin.nsf/0/DF779ACFF30EB48886257118004D35B5 '################################################################ 'base64.lss: 'Base64 1.4: %REM This set of functions will allow you to encode and decode strings and files in Base64 format. The implementation is all in LotusScript, and requires no external DLLs or tricks. It was written and tested in R5, but it should be backwards compatible to at least 4.6 This is the 1.4 "release" of the functions, from December 28, 2002. The code was originally written by Julian Robichaux, and is maintained by him on the http://www.nsftools.com website. Release History: 1.4 (Dec 28, 2002) -- fixed TrimBytesFromFile function to properly handle writing odd numbers of bytes to a new file (thanks to Peter Leugner at www.as-computer.de) 1.3 (Dec 26, 2002) -- Modified DecodeFile function to properly handle the line terminators that the Print statement adds -- Fixed GetFileChunk function to properly read the last byte in a file 1.2 (Dec 17, 2002) -- Added functions for encrypting and decrypting entire files 1.1 (Nov 5, 2002) -- Fixed typo/error in EncodeBase64 function 1.0 (Nov 1, 2002) -- Initial release %END REM '** the characters used to encode in Base64, in order of appearance Const b64chars = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" Dim pos As Integer Sub Initialize End Sub Function RemoveWhitespace (Byval text As String) As String '################################################################ ' code published by Julian Robichaux. ' http://www.openntf.org/Projects/codebin/codebin.nsf/0/DF779ACFF30EB48886257118004D35B5 '################################################################ '** remove line terminators, spaces, and tabs from a string Call ReplaceSubstring(text, Chr(13), "") Call ReplaceSubstring(text, Chr(10), "") Call ReplaceSubstring(text, Chr(9), "") Call ReplaceSubstring(text, " ", "") RemoveWhitespace = text End Function Function EncodeBase64 (decText As String) As String '################################################################ ' code published by Julian Robichaux. ' http://www.openntf.org/Projects/codebin/codebin.nsf/0/DF779ACFF30EB48886257118004D35B5 '################################################################ '** This function will Base64 encode a string. The string doesn't have to '** be text-only, either. You can also encode strings of non-ASCII data, '** like the contents of a binary file. If you're encoding a whole file, '** make sure you break the contents into lengths divisible by three, so '** you can concatenate them together properly. '** by Julian Robichaux -- http://www.nsftools.com On Error Goto endOfFunction Dim decNum As Long Dim encText As String Dim chunk As String Dim i As Integer For i = 1 To Len(decText) Step 3 '** pad the 3-character string with Chr(0), if need be chunk = Left$(Mid$(decText, i, 3) & Chr(0) & Chr(0), 3) '** get the number we'll use for encoding decNum = Asc(Mid$(chunk, 1, 1)) * (2 ^ 16) decNum = decNum Or Asc(Mid$(chunk, 2, 1)) * (2 ^ 8) decNum = decNum Or Asc(Mid$(chunk, 3, 1)) '** calculate the first 2 of 4 encoded characters encText = encText & Mid$(b64chars, (Fix(decNum / (2 ^ 18)) And &H3F) + 1, 1) encText = encText & Mid$(b64chars, (Fix(decNum / (2 ^ 12)) And &H3F) + 1, 1) '** pad with '=' as necessary when we reach the end of the string Select Case ( Len(decText) - i ) Case 0 : encText = encText & "==" Case 1 : encText = encText & Mid$(b64chars, (Fix(decNum / (2 ^ 6)) And &H3F) + 1, 1) encText = encText & "=" Case Else : encText = encText & Mid$(b64chars, (Fix(decNum / (2 ^ 6)) And &H3F) + 1, 1) encText = encText & Mid$(b64chars, (decNum And &H3F) + 1, 1) End Select Next endOfFunction: EncodeBase64 = encText Exit Function End Function Sub s_CreateFileResourceFromView_6_01 ( viewname As string, resourcename As String ) ' Sean Cull, www.focul.net, 05.08.10 ' assumes that col0 = name and col1 = contents ' contents will be comma seperated so no commas allowed in keywords Dim session As New NotesSession Dim db As NotesDatabase Dim view As NotesView Dim colle As NotesViewEntryCollection Dim entry As NotesViewEntry Dim stringvar As String Dim Head As String Dim schema As String Dim location As String Dim filename As String, imgData As Variant Dim stream As NotesStream Dim importer As NotesDXLImporter Dim counter As Integer Dim colvals As Variant Set stream = session.CreateStream Set db = session.Currentdatabase Set view = db.Getview(viewname) Set colle = view.Allentries '######################################## ' not sure if this will work with a Linux or MAC notes client ( as opposed to web ) ' does work with windows client If session.IsOnServer Then location = session.GetEnvironmentString( "NotesProgram" ,True) Else location = f_getNotesProgramDirectory_6_01 End If schema = location & "/xmlschemas" '######################################## 'Stringvar is used to create the contents of the file resource 'as you would view it if you were using the DDE editor stringvar = "# These settings are changed via the web interface - DO NOT change them here" + Chr$(10) Set entry = colle.Getfirstentry() Do Until entry Is Nothing If Not entry.Columnvalues(0) = 0 then stringvar = stringvar + Chr$(10)+ Chr$(10) + "# " + entry.Columnvalues(0) + Chr$(10) stringvar = stringvar + Replace(entry.Columnvalues(0)," ","_")+ " = " counter = 0 colvals = entry.columnvalues(1) If Not IsEmpty(colvals) Then ' multivalues present as an array, single values do not ' you will get an error if you do forall on a single value If IsArray(colvals)Then ForAll x In colvals If counter > 0 Then stringvar = stringvar + "," stringvar = stringvar + x counter = counter + 1 End ForAll Else stringvar = stringvar + colvals End if End if stringvar = stringvar + Chr$(10) End If Set entry = colle.Getnextentry(entry) Loop ' write header ' note that the noreplace flag must be set or the images get removed by the design process ' Sean Cull ' the db replica id is used to ensure a replacement of the original resource, it fails otherwise ' the version for the schema does not matter as long as it is > 8.5.0 ' in the raw XML file the contents of the file resource is encoded in base64 ' you can see this by using the Tools > DXL Utilities > Viewer head$ = ||&_ ||&_ || & EncodeBase64 (stringvar) &_ || ' we are going to place the XML into a stream and then use the stream to feed the DXL import process ' using a stream avoids having to use files and to have the agent given unrestricted rites ' the agent will, however, still need restricted rites Call stream.Writetext(Head$, ) Set importer = session.CreateDXLImporter Call importer.SetInput(stream) Call importer.SetOutput(db) ' this parameter will cause any existing file to be replaced based on the same name or alias importer.DesignImportOption = DXLIMPORTOPTION_REPLACE_ELSE_CREATE Call importer.Process Call stream.truncate End Sub Function IsBase64 (someString As String) As Integer '################################################################ ' code published by Julian Robichaux. ' http://www.openntf.org/Projects/codebin/codebin.nsf/0/DF779ACFF30EB48886257118004D35B5 '################################################################ '** check to see if the string is a well-formed Base64 string Dim legalString As String Dim i As Integer IsBase64 = False legalString = b64chars & "=" '** check for bad string length (must be a multiple of 4) If (Len(someString) Mod 4 > 0) Then Exit Function End If '** check for illegal characters For i = 1 To Len(someString) If (Instr(legalString, Mid$(someString, i, 1)) = 0) Then Exit Function End If Next '** make sure any '=' are only at the end Select Case (Instr(someString, "=")) Case 0 : '** no equals signs is okay Case Is < (Len(someString) - 1) : Exit Function Case (Len(someString) - 1) : If (Right$(someString, 1) <> "=") Then Exit Function End If End Select '** if we made it through all the conditions, then the string looks good IsBase64 = True End Function Function f_getNotesProgramDirectory_6_01 As String '################################################################ ' code courtesy of Rock Oliver / Andre Gruiard ' http://www.lotusgeek.com/SapphireOak/LotusGeekBlog.nsf/D6Plinks/ROLR-6MBMQJ '################################################################ ' Sean Cull ' this was added to allow us to get a handle on the Program directory if running on the client ' as the notes ini notesprogram only exists on servers '################################################################ ' thanks to Andre Guirard (IBM) for this function. REM modified by *Rocky Oliver (rock@us.ibm.com) to add error trapping; REM also added code to return just the dir from the null-terminated string Dim DirPath As String*512 Dim Size As Long Dim Handle As Long On Error Goto errHandler f_GetNotesProgramDirectory_6_01="" Handle=OSGetExecutableDirectory(DirPath,Size) f_GetNotesProgramDirectory_6_01=Strleft(DirPath, Chr(0)) getOut: Exit Function errHandler: On Error Goto 0 Error Err, Error$ & " [(err: " & Err & ", line: " & Erl & ") in " & Lsi_info(2) & "]" Resume getOut End Function Function ReplaceSubstring (text As String, find As String, replace2 As String) '################################################################ ' code published by Julian Robichaux. ' http://www.openntf.org/Projects/codebin/codebin.nsf/0/DF779ACFF30EB48886257118004D35B5 '################################################################ pos = Instr(text, find) Do While (pos > 0) text = Left$(text, pos - 1) & replace2 & Mid$(text, pos + Len(find)) pos = Instr(pos + Len(replace2), text, find) Loop End Function