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