strateg писал(а):Делал на основании этой статьи http://www.vbnet.ru/articles/Showarticle.aspx?id=204
strateg писал(а):1 Функция на С++ описана так
int sol_GetLemmaA( HLEM hEngine, const char * Word, char * Result, int BufSize )
2 функция
HLEMMAS sol_GetLemmasA( HLEM hEngine, const char * Word )
Выполняется лемматизация слова Word и все альтернативные варианты возвращаются в виде дескриптора списка. Для работы с этим списком далее описано несколько функций.
Public Declare Function GetLemma Lib "lemmatizator.dll" Alias "sol_GetLemmaA" (ByVal hEngine As Long, ByVal Word As String, ByVal Result As String, ByVal BufSize As Long) As Long
rez1 = GetLemma(rezlem, "простыни", resalt, 25)
Vi писал(а):заголовкам функций в ДЛЛ их имена человеческие, т.е. не перековерканы, значит, компилятору С++ помогают сформировать имена для вызова извне.
SLIM писал(а):Не факт
Private Declare Function LoadLemmatizator Lib "lemmatizator.dll" Alias "sol_LoadLemmatizatorA" (ByVal dbName As String) As Long
Private Declare Function GetLemma Lib "lemmatizator.dll" Alias "sol_GetLemmaA" (ByVal hEngine As Long, ByVal Word As String, ByVal Result As String, ByVal BufSize As Long) As Long
Private Declare Function GetLemmas Lib "lemmatizator.dll" Alias "sol_GetLemmasA" (ByVal hEngine As Long, ByVal Word As String) As Long
Private Sub Form_Load()
Dim rezlem As Long, rez1 As Long, rez2 As Long
Dim resalt As String
rezlem = LoadLemmatizator("lemmatizer.db")
'Эта функция возвращает в буфер количество лем - 3 и первую найденную
resalt = String(25, " ")
rez1 = GetLemma(rezlem, "простыни", resalt, 25)
'Эта функция должна вернуть дескриптор списка, но ничего не возвращает
rez2 = GetLemmas(rezlem, "простыни")
Unload Me
End Sub
int sol_GetLemmaW( HLEM hEngine, const wchar_t * Word, wchar_t * Result, int BufSize )
Private Declare Function GetLemmaW Lib "lemmatizator.dll" Alias "sol_GetLemmaW" (ByVal hEngine As Long, ByVal Word As String, ByVal Result As String, ByVal BufSize As Long) As Long
rez1 = GetLemmaW(rezlem, StrConv("простыни", vbFromUnicode), resalt, 25)
я преобразовал в Юникод и это помогло найти одну лемму.const wchar_t
strateg писал(а):Еще хотел спросить по поводу функции
int sol_GetLemmaW( HLEM hEngine, const wchar_t * Word, wchar_t * Result, int BufSize )
strateg писал(а):Private Declare Function GetLemmaW Lib "lemmatizator.dll" Alias "sol_GetLemmaW" (ByVal hEngine As Long, ByVal Word As String, ByVal Result As String, ByVal BufSize As Long) As Long
Private Declare Function GetLemmaW Lib "lemmatizator.dll" Alias "sol_GetLemmaW" (ByVal hEngine As Long, ByVal Word As String, ByVal Result As String, ByVal BufSize As Long) As Long
resalt = String(128, " ")
rez1 = GetLemmaW(rezlem, StrConv("простыни", vbUnicode), resalt, 64) ' ******
resalt = StrConv(resalt, vbFromUnicode)
resalt = Left(resalt, InStr(resalt, vbNullChar) - 1)
Private Declare Function GetLemmaW Lib "lemmatizator.dll" Alias "sol_GetLemmaW" (ByVal hEngine As Long, ByVal Word As Long, ByVal Result As Long, ByVal BufSize As Long) As Long
resalt = String(128, " ")
rez1 = GetLemmaW(rezlem, StrPtr("простыни"), StrPtr(resalt), 128)
resalt = Left(resalt, InStr(resalt, vbNullChar) - 1)
rez1 = GetLemmaW(rezlem, StrConv("простыни", vbUnicode), resalt, 25)
int sol_GetStrings( HGREN_STR hStr, wchar_t** Res )
(ByVal HGREN_STR As Long, ByVal massiv1 As String) или надо Byref
Dim massiv1(20) As String
rez15 = GetStrings(rez12 - указетель на массив, massiv1(0))
strateg писал(а):есть такая функция
int sol_GetStrings( HGREN_STR hStr, wchar_t** Res )
Как здесь указать типы данных? Я сделал так:
(ByVal HGREN_STR As Long, ByVal massiv1 As String) или надо Byref
Морфологический анализатор писал(а):int sol_CountStrings( HGREN_STR hStr )
Число найденных форм (то есть число элементов в векторе строк). Это число используется для выделения памяти перед вызовом функции sol_GetStrings.
int sol_GetStrings( HGREN_STR hStr, wchar_t** Res )
Вектор Res должен иметь размер, возвращаемый процедурой sol_CountStrings. Каждый элемент этого вектора - буфер для размещения строки длиной не менее, чем возвращается процедурой sol_MaxLexemLen.
DLL_ENTRY int sol_GetStrings( HGREN_STR h, wchar_t **Res )
{
if( h==NULL || Res==NULL )
return -1;
for( Container::size_type i=0; i<h->list.size(); i++ )
wcscpy( Res[i], h->list[i].c_str() );
return 0;
}
strateg писал(а):Потом нужна функция GetStrings. Она не работает. Но что мешает получить данную информацию напрямую из памяти. Указатель ведь есть и он указывает на эту область памяти. Взять байты преобразовать в текст и всё. Или я чего-то недопонимаю в этом процессе?
Private Declare Function CountStrings Lib "xxx.dll" Alias "sol_CountStrings"(ByVal hStr As Long) As Long
Private Declare Function GetStringsW Lib "xxx.dll" Alias "sol_GetStrings"(ByVal hStr As Long, ByVal vectorStringsW As Long) As Long
Public Declare Function GetMem4 Lib "msvbvm60" (ByVal pSrc As Long, ByVal pDst As Long) As Long
Public Function StrArrPtr(arr() As String, Optional ByVal IgnoreMe As Long = 0) As Long
GetMem4 VarPtr(IgnoreMe) - 4, VarPtr(StrArrPtr)
End Function
Dim massiv1() As String, addressSAFEARRRAY As Long, addressBSTRPTR As Long
Redim massiv1(CountStrings(hStr)-1)
For i=LBound(massiv1) to UBound(massiv1)
massiv1(i) = String(sol_MaxLexemLen(), vbNullChar) ' выделили на каждую строку место
Next
addressSAFEARRRAY = StrArrPtr(massiv1) ' получили адрес массива
GetMem4 addressSAFEARRRAY + 12, VarPtr(addressBSTRPTR) ' получили адрес адресов строк
rez1 = GetStringsW(hStr, addressBSTRPTR)
For i=LBound(massiv1) to UBound(massiv1)
massiv1(i) = Left(massiv1(i), InStr(massiv1(i), vbNullChar) - 1)
Next
GetMem4 addressSAFEARRRAY + 12, VarPtr(addressBSTRPTR) ' получили адрес адресов строк
rez1 = GetStrings(rez12, addressBSTRPTR)
strateg писал(а):Я прочитал в инете что функция StrArrPtr дает указатель на указатель на структуру Safearray
Поэтому добавил еще одну строку
GetMem4 addressSAFEARRRAY, VarPtr(address2)
потом
rez1 = GetStrings(rez12, address2)
Теперь действительно передается указатель на данные, но функция всё равно падает.
Почему это может быть?
addressSAFEARRRAY = StrArrPtr(massiv1) ' получили адрес адреса массива
GetMem4 addressSAFEARRRAY, VarPtr(addressSAFEARRRAY) ' получили адрес массива
GetMem4 addressSAFEARRRAY + 12, VarPtr(addressBSTRPTR) ' получили адрес адресов строк
rez1 = GetStringsW(hStr, addressBSTRPTR)
strateg писал(а):Да как раз так я и сделал, немного неверно написал, потом конечно передал указатель на данные, к сожалению этот вариант не проходит.
Может быть попытаться взять данные по указателю, который возвращает функция Getlemmas? Этот указатель указывает на список, который существует в памяти.
Сейчас попытаюсь разобраться со структурой этих списков.
extern "C" __declspec(dllexport) void __stdcall PassArrayStringW(LPWSTR *pText)
{
return;
}
Private Declare Function PassArrayStringW Lib ".\moddll.dll" Alias "_PassArrayStringW@4" (ByVal s As Long) As Long
Private Declare Function GetMem4 Lib "msvbvm60" (ByVal ptrToLongSrc As Long, ByVal ptrToLongDest As Long) As Long
Public Function StrArrPtr(arr() As String, Optional ByVal IgnoreMe As Long = 0) As Long
GetMem4 VarPtr(IgnoreMe) - 4, VarPtr(StrArrPtr)
End Function
...
Dim ss() As String
ReDim ss(2)
ss(0) = "english"
ss(1) = "русский
Dim addressSAFEARRRAY As Long, addressBSTRPTR As Long
GetMem4 StrArrPtr(ss), VarPtr(addressSAFEARRRAY)
GetMem4 addressSAFEARRRAY + 12, VarPtr(addressBSTRPTR)
PassArrayStringW addressBSTRPTR
strateg писал(а):Может быть попытаться взять данные по указателю, который возвращает функция Getlemmas? Этот указтель указывает на список, который существует в памяти.
' sol_LoadLemmatizatorA sol_LoadLemmatizatorW sol_LoadLemmatizator8
Private Declare Function LoadLemmatizator Lib "lemmatizator.dll" Alias "sol_LoadLemmatizatorA" (ByVal dbName As String) As Long
Private Declare Function LoadLemmatizatorW Lib "lemmatizator.dll" Alias "sol_LoadLemmatizatorW" (ByVal dbNameW As Long) As Long
' sol_DeleteLemmatizator
Private Declare Sub DeleteLemmatizator Lib "lemmatizator.dll" Alias "sol_DeleteLemmatizator" (ByVal hEngine As Long)
' sol_GetLemmaA sol_GetLemmaW sol_GetLemma8
Private Declare Function GetLemma Lib "lemmatizator.dll" Alias "sol_GetLemmaA" (ByVal hEngine As Long, ByVal Word As String, ByVal Result As String, ByVal BufSize As Long) As Long
Private Declare Function GetLemmaW Lib "lemmatizator.dll" Alias "sol_GetLemmaW" (ByVal hEngine As Long, ByVal WordW As Long, ByVal ResultW As Long, ByVal BufSize As Long) As Long
' sol_GetLemmasA sol_GetLemmasW sol_GetLemmas8
Private Declare Function GetLemmas Lib "lemmatizator.dll" Alias "sol_GetLemmasA" (ByVal hEngine As Long, ByVal Word As String) As Long
Private Declare Function GetLemmasW Lib "lemmatizator.dll" Alias "sol_GetLemmasW" (ByVal hEngine As Long, ByVal WordW As Long) As Long
' sol_CountLemmas
Private Declare Function CountLemmas Lib "lemmatizator.dll" Alias "sol_CountLemmas" (ByVal hList As Long) As Long
' sol_GetLemmaStringA sol_GetLemmaStringW sol_GetLemmaString8
Private Declare Function GetLemmaString Lib "lemmatizator.dll" Alias "sol_GetLemmaStringA" (ByVal hList As Long, ByVal iIndex As Long, ByVal Result As String, ByVal BufSize As Long) As Long
Private Declare Function GetLemmaStringW Lib "lemmatizator.dll" Alias "sol_GetLemmaStringW" (ByVal hList As Long, ByVal iIndex As Long, ByVal ResultW As Long, ByVal BufSize As Long) As Long
' sol_DeleteLemmas
Private Declare Sub DeleteLemmas Lib "lemmatizator.dll" Alias "sol_DeleteLemmas" (ByVal hList As Long)
Private Sub Form_Load()
Dim hEngine As Long, hList As Long, ansiVersion As Boolean
Dim resalt As String, rez1 As Long, s As String, i As Long
Dim s1 As String, s2 As String, b1() As Byte, b2() As Byte
ansiVersion = True
Stop
If ansiVersion Then
hEngine = LoadLemmatizator("lemmatizer.db")
Else
hEngine = LoadLemmatizatorW(StrPtr("lemmatizer.db"))
End If
' Debug.Print Hex(hEngine)
s = "простыни"
' s = "роем"
'Эта функция возвращает в буфер количество лем - 3 и первую найденную
resalt = String(128, vbNullChar)
If ansiVersion Then
rez1 = GetLemma(hEngine, s, resalt, Len(resalt))
Else
rez1 = GetLemmaW(hEngine, StrPtr(s), StrPtr(resalt), Len(resalt))
End If
resalt = Left(resalt, InStr(resalt, vbNullChar) - 1)
Debug.Print rez1, Len(s), s, Len(resalt), resalt
'Эта функция должна вернуть дескриптор списка, но ничего не возвращает
hList = GetLemmas(hEngine, s)
rez1 = CountLemmas(hList)
Debug.Print rez1, Len(s), s
For i = 0 To CountLemmas(hList) - 1
resalt = String(128, vbNullChar)
If ansiVersion Then
rez1 = GetLemmaString(hList, i, resalt, Len(resalt))
Else
rez1 = GetLemmaStringW(hList, i, StrPtr(resalt), Len(resalt))
End If
resalt = Left(resalt, InStr(resalt, vbNullChar) - 1)
Debug.Print rez1, Len(s), s, Len(resalt), resalt
Next
Call DeleteLemmas(hList)
Call DeleteLemmatizator(hEngine)
Unload Me
End Sub
rezgr = CreateGrammarEngineA("Dic\dictionary.xml")
reztok = Tokenize(rezgr, StrConv("Кошка пьет молоко", vbUnicode), 1)
Dim massiv1() As String
Dim addressSAFEARRRAY As Long
Dim addressBSTRPTR As Long
ReDim massiv1(CountStrings(reztok) - 1)
proverk1 = MaxLexemLen(rezgr) - максимальная 29
For i = LBound(massiv1) To UBound(massiv1)
massiv1(i) = String(MaxLexemLen(rezgr), vbNullChar) ' выделили на каждую строку место
Next
addressSAFEARRRAY = StrArrPtr(massiv1)
GetMem4 addressSAFEARRRAY, VarPtr(addressSAFEARRRAY)
GetMem4 addressSAFEARRRAY + 12, VarPtr(addressBSTRPTR)
rez1 = GetStrings(reztok, addressBSTRPTR)
strateg писал(а):А по поводу PassArrayStringW я не понял - это наверное не для меня? Какая-то собственная функция?
Dim rez As Long
rez = SeekWord(rezgr, StrConv("КОРОВА", vbUnicode), 1)
Dim Result2 As String
Result2 = Space(100)
xxxp = StrConv(rez, vbUnicode)
rez2 = GetEntryName(rezgr, xxxp, Result2)
Result3 = StrConv(Result2, vbFromUnicode)
strateg писал(а):Такая штука значит
...
Индекс приходится конвертировать в Unicode, потому что иначе ничего не возвращается. Но если переконвертировать в Unicode? то вместо слова Корова возвращается слово Ящик.
Возможно тут надо как-то по-другому конвертировать число, которое представляет индекс?
Private Declare Function SeekWordW Lib "xxx.dll" Alias "sol_SeekWord" (ByVal hEngine As Long, ByVal WordW As Long, ByVal AllowDynforms As Long) As Long
Private Declare Function GetEntryNameW Lib "xxx.dll" Alias "sol_GetEntryName" (ByVal hEngine As Long, ByVal EntryIndex As Long, ByVal ResultW As Long) As Long
...
Dim Result2 As String
Result2 = Space(100)
rez = SeekWordW(rezgr, StrPtr("КОРОВА"), 1)
if rez >= 0 Then rez2 = GetEntryNameW(rezgr, rez, StrPtr(Result2))
HGREN_RESPACK sol_MorphologyAnalysis( HFAIND hEngine, const wchar_t *Sentence, bool Allow_Dynforms, bool Allow_Unknown, int TimeoutMilliSec, int LanguageId )
Private Declare Function MorphologyAnalysis Lib "solarix_grammar_engine.dll" Alias "sol_MorphologyAnalysis" (ByVal hBuilder As Long, ByVal Sentense As Long, ByVal Allow_Dynforms As Integer, ByVal Allow_Unknown As Integer, ByVal TimeoutMilliSec As Long, ByVal Lang As Integer) As Long
Private Declare Function CountGrafs Lib "solarix_grammar_engine.dll" Alias "sol_CountGrafs" (ByVal hBuilder As Long) As Long
Private Declare Function CountRoots Lib "solarix_grammar_engine.dll" Alias "sol_CountRoots" (ByVal hBuilder As Long, ByVal nomergraf As Integer) As Long
Private Declare Function GetRoot Lib "solarix_grammar_engine.dll" Alias "sol_GetRoot" (ByVal hBuilder As Long, ByVal nomergraf As Integer, ByVal nomerroot As Integer) As Long
Private Declare Function GetNodeIEntry Lib "solarix_grammar_engine.dll" Alias "sol_GetNodeIEntry" (ByVal hBuilder As Long, ByVal Hroot As Long) As Long
rez = MorphologyAnalysis(rezgr, StrPtr("пила лежит на столе"), 0, 0, 100, 1)
rez2 = CountGrafs(rez) - получаем одну гарфу
rez3 = CountRoots(rez, 1) - сколько узлов в в 1-й графе
rez4 = GetRoot(rez17, 1, 1) - дескриптор узла
rez5 = GetNodeIEntry(rezgr, rez4) - должен вернуть индекс статьи
Сейчас этот форум просматривают: AhrefsBot, Google-бот, Yandex-бот и гости: 102