-------------------Micro$oft Word:-------------------
Attribute VB_Name = "OED"
Private Declare Function GetWindowsDirectory Lib "Kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Integer) As Integer
Private Declare Sub Sleep Lib "Kernel32" (ByVal dwMilliseconds As Long)
Private Function FileExists(path As String) As Boolean
FileExists = Len(Dir(path)) > 0
End Function
'LastRev. R.J.Holmgren 11/16/05 Adapted from OEDMACR8.DOC (in OED v1.14)
'
'If using OEDXP.EXE to launch the dictionary,
' do NOT add OEDXP "d=" or "e=" arguments to OED.INI's "ExeName=" parameter
'
Public Sub OEDV1()
Dim ini$, filname$, path$, exename$, sername$, appname$, fullpath$, wait$, sel$
Dim Channel, Inits, snuz
On Error GoTo errhand
wait$ = ""
Inits = 0
ini$ = String(100, 0)
ret = GetWindowsDirectory(ini$, 100)
ini$ = Left(ini$, ret) + "\" + "OED.INI"
If FileExists(ini$) Then
Else
MsgBox ("File " + Chr$(34) + ini$ + Chr$(34) + " not found - Abort")
GoTo exit_
End If
filname$ = System.PrivateProfileString(ini$, "data", "Filename")
path$ = System.PrivateProfileString(ini$, "Macro", "PathName")
exename$ = System.PrivateProfileString(ini$, "Macro", "ExeName")
sername$ = System.PrivateProfileString(ini$, "Macro", "ServiceName")
appname$ = System.PrivateProfileString(ini$, "Macro", "AppName")
On Error Resume Next
wait$ = System.PrivateProfileString(ini$, "Macro", "Wait")
If Len(wait$) = 0 Then wait$ = "4"
On Error GoTo errhand
If Len(filname$) = 0 Or Len(path$) = 0 Or Len(exename$) = 0 Or Len(sername$) = 0 Or Len(appname$) = 0 Then
MsgBox ("Improperly formed " + Chr$(34) + ini$ + Chr$(34) + " file - Abort")
GoTo exit_
End If
If Right$(filname$, 1) <> "\" Then filname$ = filname$ + "\"
Do While Right$(path$, 1) = "\"
path$ = Left$(path$, Len(path$) - 1)
Loop
If InStr(1, exename$, " ", 1) > 0 Then
fullpath$ = path$ + "\" + Left(exename$, InStr(1, exename$, " ", 1) - 1)
Else
fullpath$ = path$ + "\" + exename$
End If
If FileExists(fullpath$) Then
fullpath$ = path$ + "\" + Trim(exename$) 'Restore arguments after FileExists check
Else
MsgBox ("File " + Chr$(34) + fullpath$ + Chr$(34) + " not found - Abort")
GoTo exit_
End If
If FileExists(filname$ + "OED2.DAT") Then
If InStr(1, UCase(exename$), "OEDXP", 1) = 1 Then
fullpath$ = fullpath$ + " /d=" + Chr(34) + filname$ + Chr(34) + " /e=" + Chr(34) + path$ + Chr(34)
End If
Else
MsgBox ("File " + Chr$(34) + filname$ + "OED2.DAT" + Chr$(34) + " not found - Abort")
GoTo exit_
End If
sel$ = ""
If Selection.Type = wdSelectionNormal Then
sel$ = Selection.Text
Else
Selection.Bookmarks.Add Name:="OEDPos"
If Selection.Type = wdSelectionIP Then
Selection.Words(1).Select
If Len(Selection.Text) = 1 Then
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdMove
Selection.MoveLeft Unit:=wdWord, Count:=1, Extend:=wdExtend
End If
ElseIf Selection.Type = wdSelectionColumn And Selection.Information(wdWithInTable) Then
Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdMove
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdMove
Selection.MoveLeft Unit:=wdWord, Count:=1, Extend:=wdExtend
End If
sel$ = Selection.Text
Selection.GoTo What:=wdGoToBookmark, Name:="OEDPos"
ActiveDocument.Bookmarks("OEDPos").Delete
End If
If Len(sel$) = 1 Then
sel$ = sel$ + "#"
ElseIf Len(sel$) = 0 Then
sel$ = sel$ + "##"
ElseIf Len(sel$) > 60 Then
sel$ = Mid(sel$, 1, 59)
End If
Active = False
For Each tsk In Tasks
If InStr(tsk.Name, appname$) > 0 And Active = False And tsk.Visible = True Then
tsk.Activate
Call Sleep(500)
Active = True
Exit For
End If
Next tsk
If Active = False Then
If Len(sel$) > 0 And InStr(1, UCase(exename$), "OEDXP", 1) = 1 Then fullpath$ = fullpath$ + " " + sel$
ChDir path$
Shell fullpath$, vbNormalFocus
If InStr(1, UCase(exename$), "OEDXP", 1) = 1 Then Exit Sub
snuz = Val(wait$) * 1000
Call Sleep(snuz)
End If
PutKeys:
If InStr(1, UCase(exename$), "OEDXP", 1) = 1 Then
fullpath$ = fullpath$ + " " + sel$
ChDir path$
Shell fullpath$, vbNormalFocus
Exit Sub
End If
SendKeys "^s", True
SendKeys "^w", True
SendKeys "^l", True
SendKeys sel$, True
Call Sleep(1500) 'Time for Lookup window to fetch position in wordlist
Channel = DDEInitiate(sername$, "WinWord")
If Channel <> 0 Then
DDEExecute Channel, sel$
DDETerminate Channel
End If
exit_:
Exit Sub
errhand:
If err.Number = 4596 Then
Inits = Inits + 1
If Inits < 3 Then
Call Sleep(1000)
GoTo PutKeys
End If
Else
MsgBox ("Unknown error: " & err.Number & " (" & Chr(34) & err.Description & Chr(34) & ")")
End If
End Sub
-------------OpenOffice.org: (Andrew Brown)------------
Sub getTextForOED
Dim oDocument, oDesktop as Object
Dim oText, alpha, omega as Object
Dim oVCursor, mySelection As Object
Dim snot as string,lookmeup as string, test1 as string, test2 as string
'error handling stolen from Paolo Mantovani
On Error GoTo ErrH:
oDocument = thisComponent
oText = oDocument.Text
oVCursor = oDocument.currentcontroller.getViewCursor()
snot=oVCursor.getString()
alpha=oVCursor.getStart()
omega=oVCursor.getEnd()
If len(snot)>0 Then ' there is a selection: use that
mySelection = oText.createTextCursorByRange(alpha)
mySelection.goToRange(omega,TRUE)
else ' the cursor is a point; grab the word it's in.
mySelection = oText.createTextCursorByRange(oVCursor.getstart())
mySelection.gotoStartOfWord(TRUE)
if len(mySelection.getString())=0 then
' we have the punctuation after word bug
mySelection.goLeft(1,FALSE) ' move into the word and then go
mySelection.gotoStartofWord(FALSE)
else
' we're good, and can just go
mySelection.gotoStartofWord(FALSE)
end if
mySelection.gotoEndOfWord(TRUE)
end if
' here a routine to check for quotes and other punctuation at the start of the word ...
lookmeup=mySelection.getString()
' msgbox("lookmeup now holds " + lookmeup +" before the fix")
if len(lookmeup)=0 then ' there was a quote at the start of the word.
mySelection.goRight(1,TRUE) ' so move manually because move-by-word broken
mySelection.gotoEndOfWord(TRUE)
lookmeup=mySelection.getString()
' msgbox "The string is emtpy"
end if
' and end of the complicated workarounds.
' lookmeup is now the word that the cursor was in
' so all I do is ..
getoed(lookmeup)
ExitPoint:
Exit Sub
ErrH:
MsgBox "Error " & err & ": " & error$ & chr(13) & _
"In line : " & Erl & chr(13)
Resume ExitPoint
End Sub
Sub getoed(definition)
dim iconn, lookup,j
for j=1 to 5
iconn=DDEinitiate("OED","soffice")
if iconn<>0 then:
lookup=DDEExecute(iconn,definition)
exit for
else
wait 1000
end if
next j
if iconn<>0 then
DDETerminate(iconn)
else
res="Can't connect to the OED." & chr(13) & "Should I try to start it?"
if msgbox(res,3,"DDE Problem")=6 then
' Change this line to reflect your installation and oed.exe
shell("c:\progr~1\tools\refere~1\oed\startoed.bat",6,,TRUE)
end if
end if
end Sub
-------------WordPerfect v6.x:------------
// Oxford English Dictionary Macro for WPDOS v6.x
// R.J.Holmgren 5/12/05
// Required Files (3):
// -------- -----
// GoWP.EXE and KMD.EXE must be located in the DOS PATH
// OEDLOOKP.EXE must be located in the *same* dir as OED.EXE
// User Variables (2) "OEDDir" and "Behavior":
// ---- --------- - ------ --- --------
// Indicate fully-qualified "d:\path" to OEDLOOKP.EXE, between
// the "" quotes, on the NEXT line:
OEDDir="E:\OEDV110"
// Indicate whether to close OED and then *auto-return* to WP
// (=0), OR to leave OED open for subsequent queries
// and *manually* return to WP (=1 [default]):
Behavior=1
//--------------------------------------------------------------
Qt=NTOC(34)
IF(?EditScreen=1)
IF(STRLEN(OEDDir)>4 AND STRPOS(OEDDir;":\")=2)
DISPLAY(1)
DLGINPUT(1)
ERROR(1)
IF(SUBSTR(OEDDir;STRLEN(OEDDir);1)="\")
OEDDir=SUBSTR(OEDDir;1;STRLEN(OEDDir)-1)
ENDIF
Fn="OED.EXE"
CALL(ChkExist)
Fn="OEDLOOKP.EXE"
CALL(ChkExist)
ONERROR(Err)
LOCAL(Blk;Msg;CurDir)
Blk=0
IF(?BlockActive=0)
BlockOn(2)
PosWordNext
Blk=1
ENDIF
Msg=?BlockedText
IF(Blk=1)
BlockOff
PosGoPrevious
ENDIF
Chars="ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Temp=TOUPPER(SUBSTR(Msg;1;1))
WHILE(STRPOS(Chars;Temp)<1)
Msg=SUBSTR(Msg;2;STRLEN(Msg)-1)
Temp=TOUPPER(SUBSTR(Msg;1;1))
IF(Msg="")
Msg="Zero-length lookup word"
GO(Err)
ENDIF
ENDWHILE
Temp=TOUPPER(SUBSTR(Msg;STRLEN(Msg);1))
WHILE(STRPOS(Chars;Temp)<1)
Msg=SUBSTR(Msg;1;STRLEN(Msg)-1)
Temp=TOUPPER(SUBSTR(Msg;STRLEN(Msg);1))
IF(Msg="")
Msg="Zero-length lookup word"
GO(Err)
ENDIF
ENDWHILE
Chars=Chars+"'- "
Temp=TOUPPER(Msg)
Lgth=STRLEN(Temp)
Pos=0
REPEAT
Pos=Pos+1
Temp1=SUBSTR(Temp;Pos;1)
IF(STRPOS(Chars;Temp1)<1)
Msg="Illegal characters within "+Qt+Msg+Qt
GO(Err)
ENDIF
UNTIL(Pos=Lgth)
FileManagerDlg
Type ("=")
CurDir=?Entry
CALL(KillDlg)
DirectoryDefault(OEDDir)
ONERROR(FnNtFnd2)
FileDelete(?PathMacroPersonal+"OED-WP6.BAT")
LABEL(FnNtFnd2)
ONERROR(NoWndw)
FileNew
ONERROR(Err)
CapBeginSentence(0)
Type("@ECHO OFF") HRt
IF(Behavior=1)
Type("START /WAIT ")
ENDIF
Type("OEDLOOKP.EXE ")
IF(Behavior=0)
Type("/W ")
ENDIF
Type("/S5 "+Msg) HRt
Type("GoWP.EXE")
IF(Behavior=1)
Type(" "+Qt+"Oxford English Dictionary"+Qt)
ENDIF
HRt
Msg="Error saving file "+Qt+"OED-WP6.BAT"+Qt
FileSave(?PathMacroPersonal+"OED-WP6.BAT";165)
Close
DOSCommand("KMD.EXE /C "+?PathMacroPersonal+"OED-WP6.BAT")
EnterKey
DLGINPUT(0)
IF(Blk=0)
PosBlockBeg
BlockOn(1)
PosGoPrevious
ENDIF
DirectoryDefault(CurDir)
ELSE
Msg="User Variable OEDDir NOT Configured!"
GO(Err)
ENDIF
ELSE
Msg="Normal Edit Screen Only"
LABEL(Err)
DLGINPUT(0)
DISPLAY(1)
DLGCREATE(Result;"OED";2)
DLGCONTROL(0;;Msg)
DLGEND
ENDIF
DISPLAY(1)
QUIT
LABEL(NoWndw)
Msg="No window available"
GO(Err)
LABEL(KillDlg)
WHILE(?Dialog<>-1)
CancelKey
ENDWHILE
RETURN
LABEL(ChkExist)
a=""
ONERROR(FnNtFnd)
FileManagerDlg
Type(OEDDir+"\"+Fn)
EnterKey
Type("N")
Type(Fn)
EnterKey
a=?Entry
LABEL(FnNtFnd)
CALL(KillDlg)
IF(a<>Fn)
Msg="File "+Qt+Fn+Qt+" not found in "+Qt+OEDDir+Qt
GO(Err)
ENDIF
RETURN