home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD99699192000.psc / source / CWordNetYasu.cls < prev    next >
Encoding:
Visual Basic class definition  |  2000-08-08  |  4.6 KB  |  160 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "CWordNetYasu"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
  15. Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
  16. Private indexfile
  17.  
  18. Private Const total_wn_files = 10
  19. Private wnf(1 To total_wn_files) As CWordNetFile
  20. Private m_idx_type_names As Collection
  21. Private postagnames(1 To 4) As String
  22.  
  23. 'Private m_pos_type_ids As Collection
  24. 'Private Const total_pos_type_ids = 5
  25.  
  26.  
  27.  
  28. 'Private idxheadloc As Collection
  29.  
  30. Public Function Construct(indexdir As String)
  31.  
  32.  
  33.     For i = 1 To total_wn_files
  34.         Set wnf(i) = New CWordNetFile
  35.     Next i
  36.  
  37.     wnf(1).Construct indexdir, "NOUN.IDX"
  38.     'm_pos_type_ids.Add 1, "n"
  39.     wnf(2).Construct indexdir, "Verb.IDX"
  40.     'm_pos_type_ids.Add 2, "v"
  41.     wnf(3).Construct indexdir, "ADJ.IDX"
  42.     'm_pos_type_ids.Add 3, "a"
  43.     wnf(4).Construct indexdir, "ADV.IDX"
  44.     'm_pos_type_ids.Add 4, "r"
  45.     wnf(5).Construct indexdir, "SENSE.IDX"
  46.     wnf(6).Construct indexdir, "GLOSS.IDX"
  47.     wnf(7).Construct indexdir, "NOUN.DAT"
  48.     wnf(8).Construct indexdir, "Verb.DAT"
  49.     wnf(9).Construct indexdir, "ADJ.DAT"
  50.     wnf(10).Construct indexdir, "ADV.DAT"
  51.     'm_pos_type_ids.Add 4, "r"
  52.     Set m_idx_type_names = New Collection
  53.     m_idx_type_names.Add "lemma"
  54.     m_idx_type_names.Add "pos"
  55.     m_idx_type_names.Add "poly_cnt"
  56.     m_idx_type_names.Add "p_cnt"
  57.     m_idx_type_names.Add "ptr_symbol"
  58.     m_idx_type_names.Add "sense_cnt"
  59.     m_idx_type_names.Add "tagsense_cnt"
  60.     m_idx_type_names.Add "synset_offset"
  61.     postagnames(1) = "n"
  62.     postagnames(2) = "v"
  63.     postagnames(3) = "a"
  64.     postagnames(4) = "r"
  65. End Function
  66. Public Function Destruct()
  67.     For i = 1 To total_wn_files
  68.         wnf(i).Destruct
  69.     Next i
  70. End Function
  71.  
  72.  
  73.  
  74. Public Function GetXMLIdx(sword As String) As String
  75.     something_found = False
  76.     For i = 1 To 4
  77.         sposline = getxmlpos(sword, i)
  78.         If sposline <> Empty Then
  79.             something_found = True
  80.             'sresult = sresult + xmlout(sposline, postagnames(i))
  81.             sresult = sresult & xmlout(xmlout(postagnames(i), "t") & sposline, "p")
  82.         End If
  83.         
  84.     Next i
  85.     If something_found = True Then
  86.     
  87.         sresult = xmlout(UCase(sword), "k") + sresult
  88.         header = "<?xml version='1.0'?><?xml-stylesheet type=""text/xsl"" href=""idx.xsl"" ?>"
  89.         GetXMLIdx = header + xmlout(sresult, "idx")
  90.     End If
  91.     
  92. End Function
  93. Private Function getxmlpos(sword As String, posno) As String
  94.     getxmlpos = Empty
  95.     If wnf(posno).SeekByWord(sword, line) <> 0 Then
  96.         Exit Function
  97.     End If
  98.     elms = StrSplit(line, " ")
  99.     howmany = elms(2)
  100.     fromwhere = 6 + elms(3)
  101.     Dim i As Long
  102.     For i = fromwhere To fromwhere + howmany - 1
  103.          'sresult = sresult & elms(i) & vbCrLf
  104.          sresult = sresult + xmlout(getxmlsynset(Int(elms(i) + 1), posno), "s")
  105.     Next
  106.     getxmlpos = sresult
  107.  
  108. End Function
  109. Private Function getxmlsynset(seekloc As Long, posno) As String
  110.     getxmlsynset = Empty
  111.     Dim elms, elms2
  112.     wnf(posno + 6).Seek2 (seekloc)
  113.     line = wnf(posno + 6).ReadLine
  114.     If line = Empty Then
  115.         Exit Function
  116.     End If
  117.     elms = StrSplit(line, "|")
  118.     elms2 = StrSplit(elms(0), " ")
  119.     'wcnt = elms2(3)
  120.     wcnt = Val("&H" & elms2(3))
  121.     For i = 0 To wcnt - 1
  122.         wd = elms2(4 + i * 2)
  123.         If wd <> key Then
  124.             wd = Replace(wd, "_", " ")
  125.          sresult = sresult + xmlout(wd, "w")
  126.         End If
  127.     
  128.     Next
  129.     p_cnt = Int(elms2(4 + 2 * wcnt))
  130.     gloss = xmlproperstring(elms(1))
  131.     sresult = sresult + xmlout(gloss, "g")
  132.     getxmlsynset = sresult
  133.  
  134. End Function
  135.  
  136. Private Function xmlproperstring(line)
  137.     line = Replace(line, "&", "&")
  138.     line = Replace(line, "<", "<")
  139.     line = Replace(line, ">", ">")
  140.     xmlproperstring = line
  141. End Function
  142. Private Function xmlout(line, Tag, Optional optarg = "")
  143.     sresult = "<" + Tag
  144.     If optarg <> "" Then
  145.         sresult = sresult + " "
  146.     End If
  147.     sresult = sresult + optarg + ">"
  148.     sresult = sresult + line
  149.     sresult = sresult + "</" + Tag + ">"
  150.     xmlout = sresult
  151. End Function
  152.  
  153. Private Function xmloutsynset(line, key):
  154.     Dim elms
  155.     elms = StrSplit(line, "|")
  156.     elms = StrSplit(elms(0), " ")
  157.     sresult = "\n"
  158.  
  159. End Function
  160.