Lotus C Api и русские пути к базам...

  • Автор темы Alexander (Criz)
  • Дата начала
Статус
Закрыто для дальнейших ответов.
A

Alexander (Criz)

#1
Знаю что называть файлы по-русски плохо, но так "исторически сложилось"...

Есть библиотека для получения Activity в базах, но она работает только с базами, созданных с английскими названиями файлов..
Помогите, пожалуйста, поправить скрипт, чтобы можно было работать и с русскими..

Код:
Option Public
Option Explicit
Private Const wAPIModule = "NNOTES" ' Windows/32
Const MAXALPHATIMEDATE = 80

Type TIMEDATE
Innard1 As Long
Innard2 As Long
End Type

Type DBACTIVITY
First As TIMEDATE
Last As TIMEDATE
Uses As Long
Reads As Long
Writes As Long
PrevDayUses As Long
PrevDayReads As Long
PrevDayWrites As Long
PrevWeekUses As Long
PrevWeekReads As Long
PrevWeekWrites As Long
PrevMonthUses As Long
PrevMonthReads As Long
PrevMonthWrites As Long
End Type

Type DBACTIVITY_ENTRY
Time As TIMEDATE
Reads As Integer
Writes As Integer
UserNameOffset As Long
End Type

Declare Function W32_NSFDbOpen Lib wAPIModule Alias "NSFDbOpen" ( Byval dbName As String, hDb As Long ) As Integer
Declare Function W32_NSFDbClose Lib wAPIModule Alias "NSFDbClose" ( Byval hDb As Long ) As Integer
Declare Function W32_NSFDbGetUserActivity Lib wAPIModule Alias "NSFDbGetUserActivity" ( Byval hDB As Long, Byval flags As Long, retDbActivity As DBActivity, rethUserInfo As Long, retUserCount As Long ) As Integer
Declare Function W32_OSLockObject Lib wAPIModule Alias "OSLockObject" ( Byval handle ) As Long
Declare Sub OSUnlockObject Lib wAPIModule Alias "OSUnlockObject" ( Byval handle )
Declare Sub W32_OSMemFree Lib wAPIModule Alias "OSMemFree" ( Byval handle )
Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" ( hpvDest As Any, hpvSource As Any, Byval cbCopy As Long )
Declare Sub CopyMemoryString Lib "KERNEL32" Alias "RtlMoveMemory" ( Byval hpvDest As Lmbcs String, Byval hpvSource As Long, Byval cbCopy As Long )
Declare Sub ConvertTIMEDATEToText Lib wAPIModule Alias "ConvertTIMEDATEToText" ( Byval IntlFormat As Long,Byval TextFormat As Long, actTIMEDATE As TIMEDATE, Byval retTextBuffer As String,Byval TextBufferLength As Integer,retTextLength As Integer )
Declare Private Sub OSPathNetConstruct Lib wAPIModule Alias "OSPathNetConstruct" _
( Byval PortName As String, Byval ServerName As String,Byval FileName As String, Byval retPathName As String )

Class NotesUserActivityEntry
Public UserName As String
Public Reads As Long
Public Writes As Long
Public Time As String
End Class

Class NotesUserActivity

Private hDb As Long
Private pDbActivity As DBACTIVITY
Private rethUserInfo As Long
Private retUserCount As Long
Private prvdb As NotesDatabase
Private flgHasActivity As Integer

Sub Delete
If Me.flgHasActivity Then Call W32_OSMemFree( rethUserInfo )
If hDb <> 0 Then Call W32_NSFDbClose( hDb ) 
End Sub

Sub New( inpNotesDatabase As NotesDatabase )
Dim sDatabase As String
Dim rc As Integer 

Me.flgHasActivity = False

'Get a valid NotesDatabase to the specified database 
If inpNotesDatabase Is Nothing Then 
Error 14101, "NotesUserActivity: Database Object is invalid"
Exit Sub
End If

Set prvdb = New NotesDatabase( inpNotesDatabase.Server, inpNotesDatabase.FilePath )

If prvdb.Server = "" Then
sDatabase = prvdb.filepath
Else
sDatabase = String( 1024, " " )
Call OSPathNetConstruct( Chr( 0 ), prvdb.server, prvdb.filepath, sDatabase )
End If

Me.flgHasActivity = False

'Open the target database
rc = W32_NSFDbOpen( sDatabase, Me.hDb )
If rc = 0 Then

'Get the Summary User information
rc = W32_NSFDbGetUserActivity( Me.hDb, &h0, Me.pDbActivity, Me.rethUserInfo, Me.retUserCount )

If rc = 0 Then Me.flgHasActivity = True
Else
Print "Open database failed"
End If
End Sub 

'Global Times
Public Function First As String
First = ConvertTIMEtoText( pDbActivity.First ) 
End Function
Public Function Last As String
Last = ConvertTIMEtoText( pDbActivity.Last ) 
End Function

'Total summary
Public Function Uses As Long
Uses = pDbActivity.Uses 
End Function
Public Function Reads As Long
Reads = pDbActivity.Reads 
End Function
Public Function Writes As Long
Writes = pDbActivity.Writes
End Function

'Day summary
Public Function PrevDayUses As Long
PrevDayUses = pDbActivity.PrevDayUses 
End Function
Public Function PrevDayReads As Long
PrevDayReads = pDbActivity.PrevDayReads 
End Function
Public Function PrevDayWrites As Long
PrevDayWrites = pDbActivity.PrevDayReads
End Function

'Week summary
Public Function PrevWeekUses As Long
PrevWeekUses = pDbActivity.PrevWeekUses 
End Function
Public Function PrevWeekReads As Long
PrevWeekReads = pDbActivity.PrevWeekReads
End Function
Public Function PrevWeekWrites As Long
PrevWeekWrites= pDbActivity.PrevWeekWrites
End Function

'Month summary
Public Function PrevMonthUses As Long
PrevMonthUses = pDbActivity.PrevMonthUses 
End Function
Public Function PrevMonthReads As Long
PrevMonthReads = pDbActivity.PrevMonthReads 
End Function
Public Function PrevMonthWrites As Long
PrevMonthWrites = pDbActivity.PrevMonthWrites
End Function

Public Function UserActivityCount As Long
UserActivityCount = retUserCount
End Function

Public Function HasUserActivity As Integer
HasUserActivity = Me.flgHasActivity
End Function

Public Function Parent As NotesDatabase
Set Parent = prvdb
End Function

Public Function GetNthUserActivityEntry( inpEntry As Long ) As NotesUserActivityEntry
Dim puActivity As Long
Dim lEntry As Long
Dim puActivityEntry As DBACTIVITY_ENTRY
Dim StructureOffset As Long
Dim UsernameOffset As Long
Dim spUsername As String * 256
Dim sUsername As String
Dim nuae As New NotesUserActivityEntry

lEntry = inpEntry - 1

If Not Me.flgHasActivity Then Error 14104, "NotesUserActivity: No activity available"

If lEntry > Me.retUserCount Or lEntry < 0 Then
Error 14103, "NotesUserActivity: Subscript out of range."
End If

'Lock the structure get the required entry
puActivity = W32_OSLockObject( Me.rethUserInfo )
StructureOffset = puActivity + ( Lenb( puActivityEntry ) * lEntry )
Call CopyMemory ( puActivityEntry, Byval StructureOffset, Lenb( puActivityEntry ) )

'Load the User name for the Activity Structure
UsernameOffset = puActivity + puActivityEntry.UserNameOffset
spUsername = Space( 256 )
Call CopyMemoryString( spUsername, UsernameOffset, Lenb( spUsername ) )

sUserName = Left( spUsername, Instr( spUsername, Chr( 0 ) ) - 1 )

With nuae
.UserName = sUserName
.Reads = puActivityEntry.Reads
.Writes = puActivityEntry.Writes
.Time = ConvertTIMEtoText( puActivityEntry.Time )
End With

Call OSUnlockObject( rethUserInfo )

Set GetNthUserActivityEntry = nuae

End Function
End Class
Function ConvertTIMEtoText(TIMESTRUCT As TIMEDATE) As String

Dim spTime As String * MAXALPHATIMEDATE
Dim retLength As Integer

spTime = Space(MAXALPHATIMEDATE)
Call ConvertTIMEDATEToText (&h0,&h0, TIMESTRUCT, spTime,MAXALPHATIMEDATE,retLength)
ConvertTIMEtoText = Left(spTime,retLength)
End Function
 
O

oshmianski

#2
не пробовал, но может As Lmbcs String в W32_NSFDbOpen использовать?
 
A

Alexander (Criz)

#3
oshmianski
Проблема в том, что я совсем не силён в С API и мне сложно менять код..
Подскажи куда что можно добавить\изменить и я отчитаюсь о тесте..

Ещё встретил такую вещь: OSTranslate
Но опять же не готов написать нужные строчки...
 
O

oshmianski

#4
Declare Function W32_NSFDbOpen Lib wAPIModule Alias "NSFDbOpen" ( Byval dbName As String, hDb As Long ) As Integer
замените на
Declare Function W32_NSFDbOpen Lib wAPIModule Alias "NSFDbOpen" ( Byval dbName As Lmbcs String, hDb As Long ) As Integer
 
Статус
Закрыто для дальнейших ответов.