Const successLog = "c: replace_design_success.txt"
Const errorlog = "c: replace_design_error.txt"
Const infocival_design_class = 3
Const nsf_info_size = 128
Const maxword = & hffff
Const field_title = "$ title"
Const Note_class_icon = & h0010
Const special_id_not = & h8000
DIM RC AS INTEGER
Declare Function W32_NSFDbOpen Lib "nnotes.dll" Alias "NSFDbOpen" (Byval PathName As String, rethDB As Long) As Integer Declare Function W32_NSFDbClose Lib "nnotes.dll" Alias "NSFDbClose" (Byval hDB As Long) As Integer Declare Function W32_NSFDbInfoGet Lib "nnotes.dll" Alias "NSFDbInfoGet" (Byval hDB As Long, Byval retBuffer As String) As Integer Declare Function W32_NSFDbInfoSet Lib "nnotes.dll" Alias "NSFDbInfoSet" (Byval hDB As Long, Byval Buffer As String) As Integer Declare Sub W32_NSFDbInfoModify Lib "nnotes.dll" Alias "NSFDbInfoModify" (Byval Info As String, Byval What As Integer, Byval Buffer As String) Declare Sub W32_NSFDbInfoParse Lib "nnotes.dll" Alias "NSFDbInfoParse" (Byval Info As String, Byval What As Integer , Byval Buffer As String, Length As Integer) Declare Function W32_NSFNoteOpen Lib "nnotes.dll" Alias "NSFNoteOpen" (Byval hDb As Long, Byval NoteID As Long, Byval OpenFlags As Integer, rethNote As Long) As Integer Declare Function W32_NSFNoteClose Lib " nnotes.dll "a lias "NSFNoteClose" (Byval hNote As Long) As Integer Declare Function W32_NSFNoteUpdate Lib "nnotes.dll" Alias "NSFNoteUpdate" (Byval hNote As Long, Byval UpdateFlags As Integer) As Integer Declare Function W32_NSFItemSetText Lib "nnotes.dll" Alias "NSFItemSetText (Byval Hnote as stay, Byval TEXT AS STRING, BYVAL TEXTLENGTH AS INTEGER AS INTEGER SUB INTILALIZE
Dim session As NotesSession Dim db As NotesDatabase Dim dc As NotesDocumentCollection Dim doc As NotesDocument Dim nnUser As NotesName Dim nnServer As NotesName Dim TempEntry As String Dim Msg As String Dim MailFile As String Dim Databases () As String '' Array to store each persons server , user name and mail file Dim NumDatabases As Integer '' Total number of databases to process Dim Answer As Integer Dim NewTemplate As String '' name of new design template to be replaced on each database Dim OldTemplate As String '' name of current design template on each database Dim Templates As String''Names of templates to replace on each database Dim hDB As Long '' Database handle Dim szInfoBuffer As String * NSF_INFO_SIZE '' Database information buffer Dim NumSuccess As Integer '' Number of successful databases processed Dim NumUnsuccess As Integer '' Number of Unsuccessful Databases ProcessedSet Session = New Notessession Set DB = Session.currentDatabase Set DC = DB.UnprocessedDocuments if Dc.count = 0 "There is no documents selected", "error" end endiff
Answer = msgbox ("You area on" & dc.count & "catabases." & Chr $ (13) & chr $ (13) & _ "do you want to continche?", 4, " Replace design template "Screen.Width / 2) this.width = screen.width / 2" vSpace = 2 border = 0> if Answer = 7 Then Print "Aborted ...." End End IF
'' PROMPT for New Database Design Template for Each Database
NewTemplate = Inputbox ( "Enter the new design template name", "Design Templates", "StdR46Mail" screen.width / 2) this.width = screen.width / 2 "vspace = 2 border = 0> If NewTemplate =" "Then Print "Aborted ...." End End If''Option or Allow The User to Choose to Replace The Design of Databases That Match A Partic Template
Templates = "" Answer = Msgbox ( "Do you only want to replace the design on databases that has a particular design template?", 4, "Replace Design on some Databases" screen.width / 2) this.width = screen.width / 2 "vspace = 2 border = 0> If Answer = 6 Then Templates = Inputbox (" Enter the design template (s) on databases you wish to have replaced, seperated by spaces "," Design Templates "," StdR45Mail StdR46Mail StdR46ComboMail " Screen.width / 2) this.width = Screen.width / 2 "vSpace = 2 border = 0> templates = ucase (templates) if templates =" "the print" Aborted .... "end End if endiff
'' Open Two the Output Files
Open SuccessLog for Output As # 1 Open Errorlog for Output AS # 2
'' Extract All of the Selected Person Documents, And Store Each One To An Array That Contains The Server, User Name and Mail File '' Check IF The Server Name or Mail File Field Is Blank
NumDatabases = 0 NumSuccess = 0 NumUnsuccess = 0 Set doc = dc.GetFirstDocument While Not doc Is Nothing Set nnUser = New NotesName (doc.FullName (0)) Set nnServer = New NotesName (doc.MailServer (0)) MailFile = Trim $ (Doc.mailfile (0))
If nnServer.Abbreviated = "" Or MailFile = "" Then NumUnSuccess = NumUnSuccess 1 Msg = "Invalid Server or MailFile for" & nnUser.Abbreviated Print Msg Print # 2, Msg Else Redim Preserve Databases (NumDatabases) Databases (NumDatabases) = NNServer.abbreviated & "!!" & nnuser.abbreviated & "!!" & mailfile numDatabases = Numdatabases 1 end ifset doc = dc.getnextdocument (doc) Wend
'' Sort the array sale a Simple Case-Insensitive Bubble Sort Routine, this Will Basically Group All Databases on the Same Server Together
Call bubblesort (Databases ())
'' Now Process All Databases in the main routine
FORALL Entry in Databases
'' Extract The Server Name, User Name and Database IN Turn from the array
Tempensry = entry set nnserver = new notesname (Left $ (Tempensry, Instr (Tempensry, "!!" Screen.width / 2) this.width = Screen.width / 2 "vSpace = 2 border = 0> -1)) TempenTry = Right $ (TempenTry, "" - INSTR (Tempensry, "!!" Screen.width / 2) this.width = screen.width / 2 "vSpace = 2 border = 0> - 1) set nnuser = new notesname (Left $ (Tempensry, Instr (Tempensry, "!!" Screen.width / 2) this.width = Screen.width / 2 "vspace = 2 border = 0> -1)) TempenTry = Right $ (TempenTry, Len TempenTry - instr (Tempensry, "!!" Screen.width / 2) this.width = Screen.width / 2 "vSpace = 2 border = 0> - 1) mailfile = TempenTry
'' First, Open the Database and Get The Handle To The Database, Return An Error If The Database Cannot Be Opened
HDB = 0 rc = w32_nsfdbopen (NNServer.abbreviated & "!!" & mailfile, hdb) IF rc <> 0 THEN NUMUNSUCCESS = NumunSuccess 1 msg = "Error" & RC & "- Unable to open database" & mailfile " ("& Nnuser.abbreviated &" screen.width / 2) this.width = screen.width / 2 "vSpace = 2 border = 0>" Print MSG Print # 2, MSG goto getnextDatabase End If'get The Database Infomation Buffer and extract the current template name. If the template matches one '' of the templates we want to replace, or we want to replace the template regardless of the template, then '' the database information buffer (in database properties) will be set to Reflect the new template name. '' Capture Any Errors
OldTemplate = "" If (UpdateDatabaseInfo (hDB, szInfoBuffer, MailFile, NewTemplate, Templates, OldTemplate, Msg)) Then NumUnSuccess = NumUnSuccess 1 Print Msg Print # 2, Msg Goto FinishReplaceDesign End If
'' The $ Title field also needs updating in the database icon object. This field contains the same information '' that is stored in the database information buffer. So we will open the note ID of the icon object, then '' replace the $ Title Field with the new information buffer, That Contains the title of the datplase as well as '' the design template name
IF (UpdatedTabaseiconnote (HDB, Szinfobuffer, Mailfile, MSG)) Then Print Msg Print # 2, MSG Goto FinishreplaceDesign End IF
'' No Errors Occurred, DatabaseS Design Was SucessFully Replace
Numsuccess = NumsuCcess 1 msg = "Completed" & nnserver.abbreviated & "& mailfile &" ("& nnuser.abbreviated &" screen.width / 2) this.width = Screen.width / 2 "vSpace = 2 border = 0> "& OldTemplate &" -> "& newtemplate print # 1, MSGFINISHREPLACEDESIGN:
'' Close the Database if IT IS Open
IF HDB <> 0 THEN W32_NSFDBCLOSE (HDB) endiff
GetNextDatabase:
End forall
'' Close the Output Files
Close # 1 close # 2
'' *** show the results
Msg = "Replace Design": & chr $ (13) & chr $ (13) msg = msg & "surcessful:" & numsuccess & chR $ (13) msg = msg & "unsuccessful:" & NumunSuccess & chR $ 13) & chR $ (13) MSG = MSG & "Check the Output Files for the result" & chr $ (13) & chr $ (13) msg = msg & "The Databases Design on successful Databases Will NOT OCCUR Until the Servers Design Task is Executed, "& ChR $ (13) msg = msg &" You May Optionally Start the Design Task Immedierately By Issuing The Following Command on Each Server: "& Chr $ (13) & chr $ (13) msg = msg & "Load Design" & chR $ (13) & chR $ (13) msg = msg & "warning: it is not recommented to questsue the Above Command If the Affected Uses Are Accessing Their mail Files !!" msgbox msg, " Completed "
End Sub
Function Bubblesort (Databases () AS String
'' A Simple Bubble Sort Routine on an Array of Strings, Sorts in Ascending Order
DIM NUMELEMENTS AS INTEGER DIM Count1 AS Integer Dim Count2 AS Integer Dim Temp As String
NumElements = Ubound (Databases) If NumElements <1 Then Exit Function '' do not sort if only 1 entry to processFor Count1 = 0 To NumElements For Count2 = 0 To NumElements - 1 If Lcase (Databases (Count2))> Lcase (Databases ( COUNT2 1)) THEN TEMP = Databases (count2) Databases (count2) = Databases (count2 1) Databases (count2 1) = Temp end if Next Next NEXT
END FUNCTION
Function UpdateDatabaseInfo (hDB As Long, szInfoBuffer As String, MailFile As String, NewTemplate As String, Templates As String, OldTemplate As String, ErrorMsg As String) As Variant '' This will read a databases information buffer that contains the current title and design template
DIM Szretval As String * NSF_INFO_SIZE '' Storage for the Current Database Design Template
UpdatedatabaseInfo = false '' false = no error, true = exit with error szinfobuffer = string (nsf_info_size, 0)
'' Extract The Databases Information Buffer
RC = W32_NSFDBINFOGET (HDB, SZINFOBUFFER) IF RC <> 0 THEN UpdatedatabaseInfo = true error = "Error" & rc & "- unable to get database information buffer for" & mailfile exit function endiff
'' Extract Only The Design Template from The Information Buffer
Szretval = string (nsf_info_size, 0) Call W32_nsfdbinfoparse (Szinfobuffer, InfoParse_Design_Class, Szretval, NSF_INFO_SIZE-1) OldTemplate = Left (Szretval, Instr (Szretval, Chr (0)) - 1)
'' Check if the old template matches the option input from the user (only replace databases that has a particular template), or replace '' the databases design regardless of what the current template is (Templates = "" screen.width / 2) THIS.WIDTH = Screen.Width / 2 "vSpace = 2 border = 0> if ((Templates =" "Screen.width / 2) this.width = Screen.width / 2" vSpace = 2 border = 0> OR (Instr) (Templates, Ucase (OldTemplate)> 0)) THEN
'' Modify the information buffer with the new template name
Call W32_nsfdbinfomodify (Szinfobuffer, InfopArse_Design_class, newtemplate)
'' Update The Database with the Modified Information Buffer
rc = W32_NSFDbInfoSet (hDB, szInfoBuffer) If rc <> 0 Then UpdateDatabaseInfo = True ErrorMsg = "Error" & rc & "- Unable to set new database template for" & MailFile Exit Function End If Else UpdateDatabaseInfo = True ErrorMsg = "Database template ("& OldTemplate &" Screen.Width / 2) this.width = Screen.Width / 2 "vSpace = 2 border = 0> for" & mailfile & "was not replaced with" & newtemplate exit function)
END FUNCTION
Function UpdatedTabaseiconnote (HDB As Long, Szinfobufffer As String, Mailfile As String, ErrorMsg As String) AS VARIANT
DIM Hiconnote As Long
UpdatedatabaseInnote = false '' false = no error, true = exit with error hicnote = 0
'' Open the Databases icon Note
rc = W32_NSFNoteOpen (hDb, SPECIAL_ID_NOTE NOTE_CLASS_ICON, 0, hIconNote) If rc <> 0 Then UpdateDatabaseIconNote = True ErrorMsg = "Unable to open database icon note in" & MailFile Exit Function End Ifrc = W32_NSFItemSetText (hIconNote, FIELD_TITLE, szInfoBuffer, MAXWORD )
'' Save the Note Back to the Database
RC = W32_NSFNOTEUPDATE (Hiconnote, Int (0))
Finishfunction:
'' Close the Note, IF IT WAS Opened
IF Hiconnote <> 0 THEN W32_NSFNOTECLOSE (Hiconnote) End IF
END FUNCTION
