Attribute VB_Name = "DicModule" Option Explicit Public pShow321 As String Public pListen_FTP As String Public pListen_WordNo_T As Integer Public pSound_wordNo As String Public pListen_WordNo As Integer Public pShow_WordNo As Integer Public pPageNo As Integer Public pProgramNo As Integer Public pDicScore As String Public FTP1 As String, FTP2 As String, FTP3 As String, FTP4 As String Public FTP_Folder As String Public Love_Bible_Server As String Public VisionNeat As String Public pAcademy_Server As String Public pAcademyNo As Integer Public Score_Table As String Public Vision_Table As String Public pAnswer_Show As String Public pListenWordYes As String Public pTime As Integer Public pVoca_Listen As String Public pShadowing As String Public pVoca_W As String Public pDictationYes As String Public pToNo As Integer Public Run_ProgramNo As Integer Public pLevelNo As Integer Public pTable_RecordNo As Integer Public pWhitney_System As String Public VisionMall As String Public pProgram2 As String Public pSentenceNo As Integer Public pButton As String Public pWordNo As Integer ' imEnglish Public pURL3 As String Public pFileNo As Integer Public pLaraPage As Integer ' LaraStor Picture No Public pDataRecordNo As Integer ' Lara Story Reading or Conversation Public pDataType As String ' Lara Story Main or Josh Public pBlank As String Public M_pRecordNo As Integer Public M_pTitle As String Public pURL2 As String Public pReviewWord As String Public pTitle2 As String Public pCheckAudio As String Public EzConverNo1 As Integer, EZConverNo2 As Integer Public pDicWord As String Public pProgram As String Public pTablePage As Integer Public pLastScore(1 To 12) As String Public pTitle As String Public pToPage As Integer Public pPopUpTime As Integer Public pRepeat As String Public pProgramCodeNo As Integer Public pAcademyType As String Public pInterface As String Public pMonthlyScore(1 To 9) As Integer Public pCheckBookNo As Integer Public pRecordNo As Long Public pDayNo As Integer Public pTablePage1 As Integer Public pTablePage2 As Integer Public pWritingYes As String Public pShadowingOption As String Public pOption(1 To 3) As String Public pDate As Date Public pAutoNo As Long Public pCheckDate As Date Public pWorkBookRecordNo As Long Public pGramQuiz As String Public pUsePage As Integer Public pStudyYes(1 To 5) As String Public pLessonType As String Public pFromPage As Integer Public pCurrentPage As Integer Public pAcademyVersion As String Public VisionUpdate As String Public VisionData As String Public pStartPage As Integer Public pVocaQuiz As String Public pWorkBookDate As Date Public pMessageNo As Integer Public pVisionMessage As String Public pTeacher As String Public pUser As String Public pBookNo As Integer Public pBookOK As String Public p2009 As String Public pScore As Integer Public pTestNo As Integer Public pMyScore(1 To 8) As String Public pWhitneyPoint As String Public pSpinMessage As String Public pPoint1 As Integer Public pPoint2 As Long Public pPoint3 As Long Public pStudy As String Public pDownC As String Public pDownV As String Public pDownB As String Public pDownA As String Public pSpinNo As Integer Public pVideoFile As String Public pClassNo As Integer Public pClassName As String Public pTutorName As String Public pTutorNo As String Public vAcademy As String Public pScore2 As Integer Public pWhitney_Point As Long Public pWhitney_MyPoint As Long Public pStudentName As String Public pSoundFrom As String Public pFileName As String Public BookName As String Public BookTitle As String Public PageNo As Integer Public pSerialNo As String Public pUpdatewas As Date Public pComNo As String Public RegNo As String Public RegistNo As String Public AddDate As Integer Public WrongChange As Integer Public QL As Integer ' sub main Public EZSongSerialNo As String Public pRegisterYes As String Public pNoComputer As Integer Public pProductIs As String Public pVisionDate As Date Public vUserID As String Public pURL As String Public pSongTitle As String Public pSongNo As String Public pCDNation As String Public VisionServer As String Public pVersion As String Public nVersion As Integer Public VisionJae As String Public pPortNo As String Public pFTP2 As String Public pFTPFolder As String Public pFTPuserName As String Public pFTPPassword As String Public pFTPOut As String Public pFTP As String Public pFolder As String Public pGender As String Public pRecorderNo As Integer Public pRecorder As String Public pFirst As String Public VisionKorea As String Public DbAll As Database Public RsDic As Recordset Public rsall As Recordset Public FinalWord As String Public FinalWord2 As String Public FinalWord3 As String Public FinalWord4 As String Public FinalDef As String Public SoundIt As String Public FindVis As Boolean Public FindUse As Boolean Public FindAdds As Boolean Public pCategoryNo As Integer Public pTitleNo As Integer Public pCategoryName As String Public pCat As String Public pT As String Public pWhere As Integer Public Pic_Path As String Public Sound_Path As String Public Sound_Path2 As String Public Sound_Path3 As String Public ABCSound_Path As String Public Sound_Path4 As String Public Sentence_Path As String Public pPlayNo As Integer Public S_Left As Integer Public S_Top As Integer Public S_Width As Integer Public S_Height As Integer Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" _ (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long 'sndPlaySound Public Const SND_ASYNC = &H1 Public Const SND_SYNC = &H0 Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, _ ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, _ ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, _ ByVal dwRop As Long) As Long Public Const SRCCOPY = &HCC0020 'Copy Public Const SRCINVERT = &H660046 'XOR Public Const SRCERASE = &H440328 'Erase Public Const SRCPAINT = &HEE0086 'Wave Sound Public fOpen As Integer 'AVI를 여는데 관계하는 값 Public fSlide As Integer '슬라이더의 동작과 관여하는 값 Public LenAvi As Long 'AVI의 길이(Frame수) Public slidepos As Long '진행 슬라이더의 위치 Public AviFile As String 'AVI파일의 이름 Public DefVol As Long '윈도우의 기본 볼륨 Declare Function waveOutGetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, lpdwVolume As Long) As Long Declare Function waveOutSetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, ByVal dwVolume As Long) As Long 'MCI명령을 보낸다 Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long 'MCI명령을 실행한다 Declare Function mciExecute Lib "winmm.dll" (ByVal lpstrCommand As String) As Long ' MCI명령선언 Declare Function mciGetErrorString Lib "winmm.dll" Alias "mciGetErrorStringA" (ByVal dwError As Long, ByVal lpstrBuffer As String, ByVal uLength As Long) As Long Declare Function GetVolumeInformation Lib "kernel32" Alias "GetVolumeInformationA" _ (ByVal lpRootPathName As String, _ ByVal lpVolumeNameBuffer As String, _ ByVal nVolumeNameSize As Long, _ lpVolumeSerialNumber As Long, _ lpMaximumComponentLength As Long, _ lpFileSystemFlags As Long, _ ByVal lpFileSystemNameBuffer As String, _ ByVal nFileSystemNameSize As Long) As Long Sub Main() ' 로그인시에는 Love_bible_user를 확인한다 ' 등록시에느 love-bible-code에 등록번호가 등록된다 ' 회원 가입시 코드가 등록되었나 확인한다 ' 나머지는 데이타를 생성할 때 한다 ' app_program에서 생성되는 새로운 프로그램 번호를 찾고 추가한다 ' app_user_Program에 프로그램을 등록한다 (4개) ' 데이타 생성하기 ' app_user_program에서 프로그램이 MyLove-Bible을 찾아 프로그램번호을 안다 ' study_info에서 달이 바뀐 것을 확인하고 월이 바뀌면 App_Table and App_Program Table에 Bookno에 추가된다 ' app_table에서 프로그램 번호를 찾아 추가되는 레슨번호를 알아낸다 ' 문장과 단어 데이타를 생성하고 Study_info에 데이타가 생성된다 pAcademyType = "Whitney" pVisionDate = Date Sound_Path = App.Path + "\Sound\" Sound_Path2 = App.Path + "\MyRecord\" Sound_Path3 = App.Path + "\" ABCSound_Path = App.Path + "\ABCSound\" Pic_Path = App.Path + "\ABCPicture\" S_Left = 0 S_Top = 0 S_Width = Screen.Width / Screen.TwipsPerPixelX S_Height = Screen.Height / Screen.TwipsPerPixelY ' set_Frame2 Get_Server_academy frmDic_2022.Show 1 End Sub Public Sub Get_Server_academy() Dim Cnn As New ADODB.Connection Dim RsWeb As New ADODB.Recordset Dim sSql As String Dim CnStr As String, tSQL As String Dim VisionServer As String Dim vServerNo As Integer Dim vProgram As String vProgram = "Love_Bible" vServerNo = GetSetting("Whitney2013", "General Information", "Whitney_Server_No", 1) VisionServer = "Provider=sqloledb; Data Source=sqlsw16ssd-014.cafe24.com;Initial Catalog=whitney2022 ;User Id=whitney2022;Password=v3600724;" VisionMall = VisionServer VisionData = VisionServer VisionKorea = VisionServer Vision_Table = VisionServer VisionUpdate = VisionServer VisionNeat = VisionServer Love_Bible_Server = "Provider=sqloledb; Data Source=sql16-005.cafe24.com;Initial Catalog=whitneyacademy ;User Id=whitneyacademy;Password=v3600724;" CnStr = VisionKorea Cnn.Open (CnStr) tSQL = "select * from APP_IPData where program='" & vProgram & "'" RsWeb.Open tSQL, Cnn, adOpenForwardOnly, adLockReadOnly If Not RsWeb.EOF Or Not RsWeb.BOF Then FTP1 = RsWeb!ftp_sound FTP2 = RsWeb!FTP_ABC FTP3 = RsWeb!FTP_Record FTP4 = RsWeb!FTP_movie ' 업데이트는 한국 본사에서만 한다 End If RsWeb.Close Cnn.Close FTP1 = "Http://" + FTP1 pURL2 = FTP1 + "/Love_Bible" End Sub Sub Wave_Play(fnm As String, sw As Integer) 'API sndPlaySound Dim Ret As Integer If sw = 1 Then 'SND_ASYNC Ret = sndPlaySound(Sound_Path + fnm, SND_ASYNC) ' ElseIf sw = 2 Then 'SND_SYNC Ret = sndPlaySound(Sound_Path + fnm, SND_SYNC) ' ElseIf sw = 3 Then 'SND_SYNC Ret = sndPlaySound(Sound_Path3 + fnm, SND_ASYNC) ' cd ABCCound ElseIf sw = 4 Then 'SND_SYNC Ret = sndPlaySound(Sound_Path2 + fnm, SND_SYNC) ' cd ABCCound ElseIf sw = 5 Then 'SND_SYNC Ret = sndPlaySound(ABCSound_Path + fnm, SND_ASYNC) ' cd ABCCound ElseIf sw = 6 Then 'SND_SYNC Ret = sndPlaySound(ABCSound_Path + fnm, SND_SYNC) ElseIf sw = 7 Then 'SND_SYNC Ret = sndPlaySound(Sound_Path4 + fnm, SND_ASYNC) ' Stopable ElseIf sw = 8 Then 'SND_SYNC Ret = sndPlaySound(Sound_Path3 + fnm, SND_SYNC) ' No Stopable ElseIf sw = 9 Then 'SND_SYNC Ret = sndPlaySound(Sound_Path2 + fnm, SND_ASYNC) ' cd ABCCound End If End Sub Public Function FileExists(strFile As String) As Integer '******************************************************************************** '* Name : FileExists '* Date : Feb-17, 2000 '* Author : David Costelloe '* Returns : -1 = Does not exists 0 = Exists with zero bytes 1 = Exists > 0 Bytes '********************************************************************************* Dim lSize As Long On Error Resume Next '* set lSize to -1 lSize = -1 'Get the length of the file lSize = FileLen(strFile) If lSize = 0 Then '* File is zero bytes and exists FileExists = 0 ElseIf lSize > 0 Then '* File Exists FileExists = 1 Else '* Does not exist FileExists = -1 End If End Function Function FirstWord(Instring As String) As String Dim NewString As String NewString = Instring If Left(Instring, 1) = ";" Then NewString = Mid(Instring, 2) ElseIf Left(Instring, 1) = ":" Then NewString = Mid(Instring, 2) ElseIf Left(Instring, 1) = "," Then NewString = Mid(Instring, 2) ElseIf Left(Instring, 1) = "." Then NewString = Mid(Instring, 2) ElseIf Left(Instring, 1) = "?" Then NewString = Mid(Instring, 2) ElseIf Left(Instring, 1) = "!" Then NewString = Mid(Instring, 2) ElseIf Left(Instring, 1) = Chr(34) Then NewString = Mid(Instring, 2) ElseIf Left(Instring, 1) = "-" Then NewString = Mid(Instring, 2) ElseIf Left(Instring, 1) = "(" Then NewString = Mid(Instring, 2) ElseIf Left(Instring, 1) = ")" Then NewString = Mid(Instring, 2) ElseIf Left(Instring, 1) = "'" Then NewString = Mid(Instring, 2) ElseIf Left(Instring, 1) = Chr(13) Then NewString = Mid(Instring, 2) End If If Right(Instring, 1) = ";" Then NewString = Left(Instring, Len(Instring) - 1) ElseIf Right(Instring, 1) = ":" Then NewString = Left(Instring, Len(Instring) - 1) ElseIf Right(Instring, 1) = "," Then NewString = Left(Instring, Len(Instring) - 1) ElseIf Right(Instring, 1) = "." Then NewString = Left(Instring, Len(Instring) - 1) ElseIf Right(Instring, 1) = "?" Then NewString = Left(Instring, Len(Instring) - 1) ElseIf Right(Instring, 1) = "!" Then NewString = Left(Instring, Len(Instring) - 1) ElseIf Right(Instring, 1) = Chr(34) Then NewString = Left(Instring, Len(Instring) - 1) ElseIf Right(Instring, 1) = "-" Then NewString = Left(Instring, Len(Instring) - 1) ElseIf Right(Instring, 1) = "(" Then NewString = Left(Instring, Len(Instring) - 1) ElseIf Right(Instring, 1) = ")" Then NewString = Left(Instring, Len(Instring) - 1) ElseIf Right(Instring, 1) = "'" Then NewString = Left(Instring, Len(Instring) - 1) ElseIf Right(Instring, 1) = Chr(13) Then NewString = Left(Instring, Len(Instring) - 1) End If FirstWord = NewString End Function Function FirstWord2(Instring As String) As String Dim NewString As String NewString = Instring If Left(Instring, 1) = Chr(13) Then NewString = Mid(Instring, 3) End If FirstWord2 = NewString End Function Function FirstWord3(Instring As String) As String Dim NewString As String NewString = Instring If Right(Instring, 1) = Chr(13) Then NewString = Left(Instring, Len(Instring) - 1) End If FirstWord3 = NewString End Function Function ChangeTo(Instring As String) Dim Posdel As Integer, UseLength As Integer, i As Integer Dim NewString As String, ChangeIt As String UseLength = Len(Instring) For i = 1 To UseLength If LCase(Mid(Instring, i, 1)) = "a" Then NewString = Mid(Instring, 1, i - 1) + "p" + Mid(Instring, i + 1) Instring = "" Instring = NewString ElseIf LCase(Mid(Instring, i, 1)) = "b" Then NewString = Mid(Instring, 1, i - 1) + "t" + Mid(Instring, i + 1) Instring = "" Instring = NewString ElseIf LCase(Mid(Instring, i, 1)) = "c" Then NewString = Mid(Instring, 1, i - 1) + "m" + Mid(Instring, i + 1) Instring = "" Instring = NewString ElseIf LCase(Mid(Instring, i, 1)) = "d" Then NewString = Mid(Instring, 1, i - 1) + "n" + Mid(Instring, i + 1) Instring = "" Instring = NewString ElseIf LCase(Mid(Instring, i, 1)) = "e" Then NewString = Mid(Instring, 1, i - 1) + "y" + Mid(Instring, i + 1) Instring = "" Instring = NewString ElseIf LCase(Mid(Instring, i, 1)) = "f" Then NewString = Mid(Instring, 1, i - 1) + "k" + Mid(Instring, i + 1) Instring = "" Instring = NewString ElseIf LCase(Mid(Instring, i, 1)) = "g" Then NewString = Mid(Instring, 1, i - 1) + "q" + Mid(Instring, i + 1) Instring = "" Instring = NewString ElseIf LCase(Mid(Instring, i, 1)) = "h" Then NewString = Mid(Instring, 1, i - 1) + "r" + Mid(Instring, i + 1) Instring = "" Instring = NewString ElseIf LCase(Mid(Instring, i, 1)) = "i" Then NewString = Mid(Instring, 1, i - 1) + "j" + Mid(Instring, i + 1) Instring = "" Instring = NewString ElseIf LCase(Mid(Instring, i, 1)) = "j" Then NewString = Mid(Instring, 1, i - 1) + "i" + Mid(Instring, i + 1) Instring = "" Instring = NewString ElseIf LCase(Mid(Instring, i, 1)) = "k" Then NewString = Mid(Instring, 1, i - 1) + "f" + Mid(Instring, i + 1) Instring = "" Instring = NewString ElseIf LCase(Mid(Instring, i, 1)) = "l" Then NewString = Mid(Instring, 1, i - 1) + "s" + Mid(Instring, i + 1) Instring = "" Instring = NewString ElseIf LCase(Mid(Instring, i, 1)) = "m" Then NewString = Mid(Instring, 1, i - 1) + "c" + Mid(Instring, i + 1) Instring = "" Instring = NewString ElseIf LCase(Mid(Instring, i, 1)) = "n" Then NewString = Mid(Instring, 1, i - 1) + "d" + Mid(Instring, i + 1) Instring = "" Instring = NewString ElseIf LCase(Mid(Instring, i, 1)) = "o" Then NewString = Mid(Instring, 1, i - 1) + "o" + Mid(Instring, i + 1) Instring = "" Instring = NewString ElseIf LCase(Mid(Instring, i, 1)) = "p" Then NewString = Mid(Instring, 1, i - 1) + "a" + Mid(Instring, i + 1) Instring = "" Instring = NewString ElseIf LCase(Mid(Instring, i, 1)) = "q" Then NewString = Mid(Instring, 1, i - 1) + "g" + Mid(Instring, i + 1) Instring = "" Instring = NewString ElseIf LCase(Mid(Instring, i, 1)) = "r" Then NewString = Mid(Instring, 1, i - 1) + "h" + Mid(Instring, i + 1) Instring = "" Instring = NewString ElseIf LCase(Mid(Instring, i, 1)) = "s" Then NewString = Mid(Instring, 1, i - 1) + "l" + Mid(Instring, i + 1) Instring = "" Instring = NewString ElseIf LCase(Mid(Instring, i, 1)) = "t" Then NewString = Mid(Instring, 1, i - 1) + "b" + Mid(Instring, i + 1) Instring = "" Instring = NewString ElseIf LCase(Mid(Instring, i, 1)) = "u" Then NewString = Mid(Instring, 1, i - 1) + "x" + Mid(Instring, i + 1) Instring = "" Instring = NewString ElseIf LCase(Mid(Instring, i, 1)) = "v" Then NewString = Mid(Instring, 1, i - 1) + "z" + Mid(Instring, i + 1) Instring = "" Instring = NewString ElseIf LCase(Mid(Instring, i, 1)) = "x" Then NewString = Mid(Instring, 1, i - 1) + "u" + Mid(Instring, i + 1) Instring = "" Instring = NewString ElseIf LCase(Mid(Instring, i, 1)) = "y" Then NewString = Mid(Instring, 1, i - 1) + "e" + Mid(Instring, i + 1) Instring = "" Instring = NewString ElseIf LCase(Mid(Instring, i, 1)) = "z" Then NewString = Mid(Instring, 1, i - 1) + "v" + Mid(Instring, i + 1) Instring = "" Instring = NewString End If Next i ChangeTo = LCase(Instring) End Function Function ChangeWord2(Instring As String, Delim As String) As String Dim Posdel As Integer Dim NewString As String Posdel = InStr(Instring, Delim) While Posdel <> 0 NewString = Mid(Instring, 1, Posdel - 1) + " " + Mid(Instring, Posdel + 2) Instring = "" Instring = NewString Posdel = InStr(Instring, Delim) Wend ChangeWord2 = Instring End Function Function ChangeWord(Instring As String, Delim As String) As String Dim Posdel As Integer, UseLength As Integer, i As Integer Dim NewString As String UseLength = Len(Instring) For i = 1 To UseLength If Mid(Instring, i, 1) = ";" Then NewString = Mid(Instring, 1, i - 1) + " " + Mid(Instring, i + 1) Instring = "" Instring = NewString ElseIf Mid(Instring, i, 1) = ":" Then NewString = Mid(Instring, 1, i - 1) + " " + Mid(Instring, i + 1) Instring = "" Instring = NewString ElseIf Mid(Instring, i, 1) = "," Then NewString = Mid(Instring, 1, i - 1) + " " + Mid(Instring, i + 1) Instring = "" Instring = NewString ElseIf Mid(Instring, i, 1) = "." Then NewString = Mid(Instring, 1, i - 1) + " " + Mid(Instring, i + 1) Instring = "" Instring = NewString ElseIf Mid(Instring, i, 1) = "?" Then NewString = Mid(Instring, 1, i - 1) + " " + Mid(Instring, i + 1) Instring = "" Instring = NewString ElseIf Mid(Instring, i, 1) = "!" Then NewString = Mid(Instring, 1, i - 1) + " " + Mid(Instring, i + 1) Instring = "" Instring = NewString ElseIf Mid(Instring, i, 1) = Chr(34) Then NewString = Mid(Instring, 1, i - 1) + " " + Mid(Instring, i + 1) Instring = "" Instring = NewString ElseIf Mid(Instring, i, 1) = "-" Then NewString = Mid(Instring, 1, i - 1) + " " + Mid(Instring, i + 1) Instring = "" Instring = NewString ElseIf Mid(Instring, i, 1) = "(" Then NewString = Mid(Instring, 1, i - 1) + " " + Mid(Instring, i + 1) Instring = "" Instring = NewString ElseIf Mid(Instring, i, 1) = ")" Then NewString = Mid(Instring, 1, i - 1) + " " + Mid(Instring, i + 1) Instring = "" Instring = NewString ElseIf Mid(Instring, i, 1) = "'" Then NewString = Mid(Instring, 1, i - 1) + " " + Mid(Instring, i + 1) Instring = "" Instring = NewString End If Next i Posdel = InStr(Instring, Delim) While Posdel <> 0 'example 123:456 'first posdel 123+space+456 'the mark is anywhere no problem 'mid posdel-1 = NewString = Mid(Instring, 1, Posdel - 1) + " " + Mid(Instring, Posdel + 1) Instring = "" Instring = NewString Posdel = InStr(Posdel + 1, Instring, Delim) Wend ChangeWord = Instring End Function Function ChangeWord3(Instring As String, Delim As String) As String Dim Posdel As Integer, UseLength As Integer, i As Integer Dim NewString As String UseLength = Len(Instring) For i = 1 To UseLength If Mid(Instring, i, 1) = ";" Then NewString = Mid(Instring, 1, i - 1) + " " + Mid(Instring, i + 1) Instring = "" Instring = NewString ElseIf Mid(Instring, i, 1) = ":" Then NewString = Mid(Instring, 1, i - 1) + " " + Mid(Instring, i + 1) Instring = "" Instring = NewString ElseIf Mid(Instring, i, 1) = "," Then NewString = Mid(Instring, 1, i - 1) + " " + Mid(Instring, i + 1) Instring = "" Instring = NewString ElseIf Mid(Instring, i, 1) = "." Then NewString = Mid(Instring, 1, i - 1) + " " + Mid(Instring, i + 1) Instring = "" Instring = NewString ElseIf Mid(Instring, i, 1) = "?" Then NewString = Mid(Instring, 1, i - 1) + " " + Mid(Instring, i + 1) Instring = "" Instring = NewString ElseIf Mid(Instring, i, 1) = "!" Then NewString = Mid(Instring, 1, i - 1) + " " + Mid(Instring, i + 1) Instring = "" Instring = NewString ElseIf Mid(Instring, i, 1) = Chr(34) Then NewString = Mid(Instring, 1, i - 1) + " " + Mid(Instring, i + 1) Instring = "" Instring = NewString ElseIf Mid(Instring, i, 1) = "(" Then NewString = Mid(Instring, 1, i - 1) + " " + Mid(Instring, i + 1) Instring = "" Instring = NewString ElseIf Mid(Instring, i, 1) = ")" Then NewString = Mid(Instring, 1, i - 1) + " " + Mid(Instring, i + 1) Instring = "" Instring = NewString End If Next i Posdel = InStr(Instring, Delim) While Posdel <> 0 'example 123:456 'first posdel 123+space+456 'the mark is anywhere no problem 'mid posdel-1 = NewString = Mid(Instring, 1, Posdel - 1) + " " + Mid(Instring, Posdel + 1) Instring = "" Instring = NewString Posdel = InStr(Posdel + 1, Instring, Delim) Wend ChangeWord3 = Instring End Function Function ChangeWord5(Instring As String, Delim As String) As String Dim Posdel As Integer Dim NewString As String Posdel = InStr(Instring, Delim) While Posdel <> 0 If Posdel = 1 Then NewString = Mid(Instring, Posdel + 1) Else NewString = Left(Instring, Posdel - 1) + Mid(Instring, Posdel + 1) End If Instring = "" Instring = NewString Posdel = InStr(Instring, Delim) Wend ChangeWord5 = Instring End Function Sub FinalVisual(FromWord As String) Dim sSql As String, NewWords As String Dim Wpos As Integer On Error Resume Next Wpos = Len(FromWord) sSql = "word=" sSql = sSql + "'" + FromWord + "'" rsall.FindFirst (sSql) If Not rsall.NoMatch Then FinalWord = FromWord FinalWord2 = rsall!word FinalWord3 = rsall!code FindVis = True Exit Sub End If If Right(FromWord, 1) = "d" Then NewWords = Left(FromWord, Wpos - 1) sSql = "word=" sSql = sSql + "'" + NewWords + "'" rsall.FindFirst (sSql) If Not rsall.NoMatch Then FinalWord = FromWord FinalWord2 = rsall!word FinalWord3 = rsall!code FindVis = True Else ' find from ed If Right(FromWord, 2) = "ed" Then NewWords = Left(FromWord, Wpos - 2) sSql = "word=" sSql = sSql + "'" + NewWords + "'" rsall.FindFirst (sSql) If Not rsall.NoMatch Then FinalWord = FromWord FinalWord2 = rsall!word FinalWord3 = rsall!code FindVis = True Else If Mid(FromWord, Wpos - 2, 1) = Mid(FromWord, Wpos - 3, 1) Then NewWords = Left(FromWord, Wpos - 3) sSql = "word=" sSql = sSql + "'" + NewWords + "'" rsall.FindFirst (sSql) If Not rsall.NoMatch Then FinalWord = FromWord FinalWord2 = rsall!word FinalWord3 = rsall!code FindVis = True End If ' find from rsall End If End If End If 'find ed End If ' when no find from d End If 'finish D If Right(FromWord, 1) = "s" Then NewWords = Left(FromWord, Wpos - 1) sSql = "word=" sSql = sSql + "'" + NewWords + "'" rsall.FindFirst (sSql) If Not rsall.NoMatch Then FinalWord = FromWord FinalWord2 = rsall!word FinalWord3 = rsall!code FindVis = True Else ' not find from s If Right(FromWord, 2) = "es" Then NewWords = Left(FromWord, Wpos - 2) sSql = "word=" sSql = sSql + "'" + NewWords + "'" rsall.FindFirst (sSql) If Not rsall.NoMatch Then FinalWord = FromWord FinalWord2 = rsall!word FinalWord3 = rsall!code FindVis = True Else If Mid(FromWord, Wpos - 2, 1) = Mid(FromWord, Wpos - 3, 1) Then NewWords = Left(FromWord, Wpos - 3) sSql = "word=" sSql = sSql + "'" + NewWords + "'" rsall.FindFirst (sSql) If Not rsall.NoMatch Then FinalWord = FromWord FinalWord2 = rsall!word FinalWord3 = rsall!code FindVis = True End If End If End If ' find from rsaddword ElseIf Right(FromWord, 4) = "ings" Then NewWords = Left(FromWord, Wpos - 4) sSql = "word=" sSql = sSql + "'" + NewWords + "'" rsall.FindFirst (sSql) If Not rsall.NoMatch Then FinalWord = FromWord FinalWord2 = rsall!word FinalWord3 = rsall!code FindVis = True Else NewWords = Left(FromWord, Wpos - 4) + "e" sSql = "word=" sSql = sSql + "'" + NewWords + "'" rsall.FindFirst (sSql) If Not rsall.NoMatch Then FinalWord = FromWord FinalWord2 = rsall!word FinalWord3 = rsall!code FindVis = True End If End If ' find from rsaddword ElseIf Right(FromWord, 2) = "rs" Then NewWords = Left(FromWord, Wpos - 2) sSql = "word=" sSql = sSql + "'" + NewWords + "'" rsall.FindFirst (sSql) If Not rsall.NoMatch Then FinalWord = FromWord FinalWord2 = rsall!word FinalWord3 = rsall!code FindVis = True Else If Right(FromWord, 3) = "ers" Then NewWords = Left(FromWord, Wpos - 3) sSql = "word=" sSql = sSql + "'" + NewWords + "'" rsall.FindFirst (sSql) If Not rsall.NoMatch Then FinalWord = FromWord FinalWord2 = rsall!word FinalWord3 = rsall!code FindVis = True End If Else If Mid(FromWord, Wpos - 4, 1) = Mid(FromWord, Wpos - 3, 1) Then NewWords = Left(FromWord, Wpos - 4) sSql = "word=" sSql = sSql + "'" + NewWords + "'" rsall.FindFirst (sSql) If Not rsall.NoMatch Then FinalWord = FromWord FinalWord2 = rsall!word FinalWord3 = rsall!code FindVis = True End If End If End If End If ' find from rsuse End If ' finish es End If ' not find s try esle End If ' finish s If Right(FromWord, 2) = "ly" Then NewWords = Left(FromWord, Wpos - 2) sSql = "word=" sSql = sSql + "'" + NewWords + "'" rsall.FindFirst (sSql) If Not rsall.NoMatch Then FinalWord = FromWord FinalWord2 = rsall!word FinalWord3 = rsall!code FindVis = True Else If Right(FromWord, 5) = "fully" Then NewWords = Left(FromWord, Wpos - 5) sSql = "word=" sSql = sSql + "'" + NewWords + "'" rsall.FindFirst (sSql) If Not rsall.NoMatch Then FinalWord = FromWord FinalWord2 = rsall!word FinalWord3 = rsall!code FindVis = True End If End If End If End If If Right(FromWord, 5) = "ingly" Then NewWords = Left(FromWord, Wpos - 5) ' mean ful sSql = "word=" sSql = sSql + "'" + NewWords + "'" rsall.FindFirst (sSql) If Not rsall.NoMatch Then FinalWord = FromWord FinalWord2 = rsall!word FinalWord3 = rsall!code FindVis = True Else NewWords = Left(FromWord, Wpos - 5) + "e" sSql = "word=" sSql = sSql + "'" + NewWords + "'" rsall.FindFirst (sSql) If Not rsall.NoMatch Then FinalWord = FromWord FinalWord2 = rsall!word FinalWord3 = rsall!code FindVis = True End If End If End If If Right(FromWord, 3) = "ing" Then NewWords = Left(FromWord, Wpos - 3) sSql = "word=" sSql = sSql + "'" + NewWords + "'" rsall.FindFirst (sSql) If Not rsall.NoMatch Then FinalWord = FromWord FinalWord2 = rsall!word FinalWord3 = rsall!code FindVis = True Else NewWords = Left(FromWord, Wpos - 3) + "e" sSql = "word=" sSql = sSql + "'" + NewWords + "'" rsall.FindFirst (sSql) If Not rsall.NoMatch Then FinalWord = FromWord FinalWord2 = rsall!word FinalWord3 = rsall!code FindVis = True Else If Mid(FromWord, Wpos - 4, 1) = Mid(FromWord, Wpos - 3, 1) Then NewWords = Left(FromWord, Wpos - 4) sSql = "word=" sSql = sSql + "'" + NewWords + "'" rsall.FindFirst (sSql) If Not rsall.NoMatch Then FinalWord = FromWord FinalWord2 = rsall!word FinalWord3 = rsall!code FindVis = True End If End If End If ' find from rsall End If ' else no find try adding by e End If ' finish ing If Right(FromWord, 3) = "ion" Then NewWords = Left(FromWord, Wpos - 3) sSql = "word=" sSql = sSql + "'" + NewWords + "'" rsall.FindFirst (sSql) If Not rsall.NoMatch Then FinalWord = FromWord FinalWord2 = rsall!word FinalWord3 = rsall!code FindVis = True Else NewWords = Left(FromWord, Wpos - 3) NewWords = NewWords + "e" sSql = "word=" sSql = sSql + "'" + NewWords + "'" rsall.FindFirst (sSql) If Not rsall.NoMatch Then FinalWord = FromWord FinalWord2 = rsall!word FinalWord3 = rsall!code FindVis = True End If End If ' else no find try adding by e End If ' finish ing If Right(fromword, 3) = "ful" Then If Right(FromWord, 1) = "r" Then NewWords = Left(FromWord, Wpos - 1) sSql = "word=" sSql = sSql + "'" + NewWords + "'" rsall.FindFirst (sSql) If Not rsall.NoMatch Then FinalWord = FromWord FinalWord2 = rsall!word FinalWord3 = rsall!code FindVis = True Else If Right(FromWord, 2) = "er" Then NewWords = Left(FromWord, Wpos - 2) sSql = "word=" sSql = sSql + "'" + NewWords + "'" rsall.FindFirst (sSql) If Not rsall.NoMatch Then FinalWord = FromWord FinalWord2 = rsall!word FinalWord3 = rsall!code FindVis = True Else If Mid(FromWord, Wpos - 3, 1) = Mid(FromWord, Wpos - 2, 1) Then NewWords = Left(FromWord, Wpos - 3) sSql = "word=" sSql = sSql + "'" + NewWords + "'" rsall.FindFirst (sSql) If Not rsall.NoMatch Then FinalWord = FromWord FinalWord2 = rsall!word FinalWord3 = rsall!code FindVis = True End If End If ' find from rsall End If End If 'find ed End If ' else no find try adding by e End If ' finish ing If Right(fromword, 3) = "ful" Then If Right(FromWord, 3) = "ful" Then NewWords = Left(FromWord, Wpos - 3) sSql = "word=" sSql = sSql + "'" + NewWords + "'" rsall.FindFirst (sSql) If Not rsall.NoMatch Then FinalWord = FromWord FinalWord2 = rsall!word FinalWord3 = rsall!code FindVis = True End If End If If Right(FromWord, 3) = "ies" Then NewWords = Left(FromWord, Wpos - 3) NewWords = NewWords + "y" sSql = "word=" sSql = sSql + "'" + NewWords + "'" rsall.FindFirst (sSql) If Not rsall.NoMatch Then FinalWord = FromWord FinalWord2 = rsall!word FinalWord3 = rsall!code FindVis = True End If End If If Right(FromWord, 3) = "ied" Then NewWords = Left(FromWord, Wpos - 3) NewWords = NewWords + "y" sSql = "word=" sSql = sSql + "'" + NewWords + "'" rsall.FindFirst (sSql) If Not rsall.NoMatch Then FinalWord = FromWord FinalWord2 = rsall!word FinalWord3 = rsall!code FindVis = True End If End If If Right(FromWord, 4) = "less" Then NewWords = Left(FromWord, Wpos - 4) sSql = "word=" sSql = sSql + "'" + NewWords + "'" rsall.FindFirst (sSql) If Not rsall.NoMatch Then FinalWord = FromWord FinalWord2 = rsall!word FinalWord3 = rsall!code FindVis = True End If End If If Right(FromWord, 1) = "y" Then NewWords = Left(FromWord, Wpos - 1) sSql = "word=" sSql = sSql + "'" + NewWords + "'" rsall.FindFirst (sSql) If Not rsall.NoMatch Then FinalWord = FromWord FinalWord2 = rsall!word FinalWord3 = rsall!code FindVis = True Else NewWords = Left(FromWord, Wpos - 1) NewWords = NewWords + "e" sSql = "word=" sSql = sSql + "'" + NewWords + "'" rsall.FindFirst (sSql) If Not rsall.NoMatch Then FinalWord = FromWord FinalWord2 = rsall!word FinalWord3 = rsall!code FindVis = True End If End If End If If Right(FromWord, 4) = "ment" Then NewWords = Left(FromWord, Wpos - 4) sSql = "word=" sSql = sSql + "'" + NewWords + "'" rsall.FindFirst (sSql) If Not rsall.NoMatch Then FinalWord = FromWord FinalWord2 = rsall!word FinalWord3 = rsall!code FindVis = True End If End If If Right(FromWord, 3) = "ily" Then NewWords = Left(FromWord, Wpos - 3) + "y" sSql = "word=" sSql = sSql + "'" + NewWords + "'" rsall.FindFirst (sSql) If Not rsall.NoMatch Then FinalWord = FromWord FinalWord2 = rsall!word FinalWord3 = rsall!code FindVis = True End If End If If Right(FromWord, 4) = "ness" Then NewWords = Left(FromWord, Wpos - 4) sSql = "word=" sSql = sSql + "'" + NewWords + "'" rsall.FindFirst (sSql) If Not rsall.NoMatch Then FinalWord = FromWord FinalWord2 = rsall!word FinalWord3 = rsall!code FindVis = True End If End If If Right(FromWord, 2) = "th" Then NewWords = Left(FromWord, Wpos - 2) sSql = "word=" sSql = sSql + "'" + NewWords + "'" rsall.FindFirst (sSql) If Not rsall.NoMatch Then FinalWord = FromWord FinalWord2 = rsall!word FinalWord3 = rsall!code FindVis = True Else If Right(FromWord, 3) = "eth" Then NewWords = Left(FromWord, Wpos - 3) sSql = "word=" sSql = sSql + "'" + NewWords + "'" rsall.FindFirst (sSql) If Not rsall.NoMatch Then FinalWord = FromWord FinalWord2 = rsall!word FinalWord3 = rsall!code FindVis = True End If End If End If End If If Right(FromWord, 2) = "st" Then NewWords = Left(FromWord, Wpos - 2) sSql = "word=" sSql = sSql + "'" + NewWords + "'" rsall.FindFirst (sSql) If Not rsall.NoMatch Then FinalWord = FromWord FinalWord2 = rsall!word FinalWord3 = rsall!code FindVis = True Else If Right(FromWord, 3) = "est" Then NewWords = Left(FromWord, Wpos - 3) sSql = "word=" sSql = sSql + "'" + NewWords + "'" rsall.FindFirst (sSql) If Not rsall.NoMatch Then FinalWord = FromWord FinalWord2 = rsall!word FinalWord3 = rsall!code FindVis = True End If End If End If End If If Right(FromWord, 3) = "dst" Then NewWords = Left(FromWord, Wpos - 3) sSql = "word=" sSql = sSql + "'" + NewWords + "'" rsall.FindFirst (sSql) If Not rsall.NoMatch Then FinalWord = FromWord FinalWord2 = rsall!word FinalWord3 = rsall!code FindVis = True Else If Right(FromWord, 4) = "edst" Then NewWords = Left(FromWord, Wpos - 4) sSql = "word=" sSql = sSql + "'" + NewWords + "'" rsall.FindFirst (sSql) If Not rsall.NoMatch Then FinalWord = FromWord FinalWord2 = rsall!word FinalWord3 = rsall!code FindVis = True End If End If End If End If End Sub