c api应用2-刷新设计

Const SuccessLog = "c:Replace_Design_Success.txt"
 Const ErrorLog = "c:Replace_Design_Error.txt"
 Const INFOPARSE_DESIGN_CLASS = 3
 Const NSF_INFO_SIZE = 128
 Const MAXWORD = &hFFFF
 Const FIELD_TITLE = "$TITLE"
 Const NOTE_CLASS_ICON = &h0010
 Const SPECIAL_ID_NOTE = &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" Alias "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 Long, Byval ItemName As String, Byval Text As String, Byval TextLength As Integer) As Integer
 Sub Initialize

 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 processed

 Set session = New NotesSession
 Set db = session.CurrentDatabase
 Set dc = db.UnprocessedDocuments
 If dc.Count = 0 Then
           Msgbox "There are no documents selected",,"Error"
 End
 End If

 Answer = Msgbox("You are about to replace the design template on " & dc.Count & " databases." & Chr$(13) & Chr$(13) & _
 "Do you want to continue?", 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

 ''Optionally allow the user to choose to replace the design of databases that match a particual 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 = "" Then
 Print "Aborted...."
 End
 End If
 End If

 ''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 If

 Set doc = dc.GetNextDocument(doc)
 Wend

 ''Sort the array using 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

 TempEntry = Entry
 Set nnServer = New NotesName(Left$(TempEntry, Instr(TempEntry, "!!"screen.width/2)this.width=screen.width/2" vspace=2 border=0> -1))
 TempEntry = Right$(TempEntry, Len(TempEntry) - Instr(TempEntry, "!!"screen.width/2)this.width=screen.width/2" vspace=2 border=0> - 1)
 Set nnUser = New NotesName(Left$(TempEntry, Instr(TempEntry, "!!"screen.width/2)this.width=screen.width/2" vspace=2 border=0> -1))
 TempEntry = Right$(TempEntry, Len(TempEntry) - Instr(TempEntry, "!!"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 database as well as
 ''the design template name

 If (UpdateDatabaseIconNote(hDB, szInfoBuffer, MailFile, Msg)) Then
 Print Msg
 Print #2, Msg
 Goto FinishReplaceDesign
 End If

 ''No errors occurred, databases design was sucessfully replaced

 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, Msg

 FinishReplaceDesign:

 ''close the database if it is open

 If hDB <> 0 Then
 W32_NSFDbClose(hDB)
 End If

 GetNextDatabase:

 End Forall

 ''close the output files

 Close #1
 Close #2

 ''*** Show the results

 Msg = "Replace design results:" & Chr$(13) & Chr$(13)
 Msg = Msg & "Successful: " & NumSuccess & Chr$(13)
 Msg = Msg & "Unsuccessful: " & NumUnSuccess & Chr$(13) & Chr$(13)
 Msg = Msg & "Check the output files for the results" & 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 immediately 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 recommended to issue the above command if the affected users 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 process

 For 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

 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 databases 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
 ErrorMsg = "Error " & rc & " - Unable to get database information buffer for " & MailFile
 Exit Function
 End If

 ''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 If

 End Function

 Function UpdateDatabaseIconNote(hDB As Long, szInfoBuffer As String, MailFile As String, ErrorMsg As String) As Variant

 Dim hIconNote As Long

 UpdateDatabaseIconNote = False ''false = no error, true = exit with error
 hIconNote = 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 If

 rc = 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