The eccoMAGIC Forums

The eccoMAGIC Forums
http://forums.eccoMAGIC.com/forum/YaBB.pl
Ecco DDE & Add-On Programming tips, tricks, techniques (Learn & Share!) >> DDE Interfacing with Ecco - How to... >> Visual Basic example Code for Ecco DDE API (part1)
http://forums.eccoMAGIC.com/forum/YaBB.pl?num=1178007518

Message started by Admin on 05/01/07 at 03:18:38

Title: Visual Basic example Code for Ecco DDE API (part1)
Post by Admin on 05/01/07 at 03:18:38

Option Explicit

'Constants
Global Const TOPIC_NAME = "Ecco|Ecco"

'Link Mode constants
Global Const DDE_MODE_NONE = 0
Global Const DDE_MODE_AUTOMATIC = 1
Global Const DDE_MODE_MANUAL = 2
Global Const DDE_MODE_NOTIFY = 3

'getFolderItems constants
Global Const DDE_ST_VALUEASCENDING = "va"
Global Const DDE_ST_VALUEDESCENDING = "vd"
Global Const DDE_ST_ITEMASCENDING = "ia"
Global Const DDE_ST_ITEMDESCENDING = "va"
Global Const DDE_ST_DEFAULT = ""
Global Const DDE_CR_BEGINSWITH = "IB"
Global Const DDE_CR_TEXTCONTAINS = "IC"
Global Const DDE_CR_NOTTEXTCONTAINS = "IN"
Global Const DDE_CR_TXTFLDBEGINS = "TB"
Global Const DDE_CR_TXTFLDCONTAINS = "TC"
Global Const DDE_CR_TXTFLDNOTCONTAIN = "TN"
Global Const DDE_CR_FLDEQUALS = "EQ"
Global Const DDE_CR_GREATER = "GR"
Global Const DDE_CR_LESS = "LT"
Global Const DDE_CR_GREATEREQUAL = "GE"
Global Const DDE_CR_LESSEQUAL = "LE"
Global Const DDE_CR_NOTEQUAL = "NE"
Global Const DDE_CR_NOCRITERIA = ""

'pasteOleItem constants
Global Const DDE_FL_LINK = 1
Global Const DDE_FL_OBJECT = 2

'ecco folder types
Global Const DDE_FLDR_ALL = 0
Global Const DDE_FLDR_CHECKMARK = 1
Global Const DDE_FLDR_DATE = 2
Global Const DDE_FLDR_NUMBER = 3
Global Const DDE_FLDR_TEXT = 4
Global Const DDE_FLDR_POPUPLIST = 5

'ecco item types
Global Const DDE_ITEM_TEXT = 1
Global Const DDE_ITEM_OLELINK = 2

Sub centerForm (x As Form)

screen.MousePointer = 11
x.Top = (screen.Height * .85) / 2 - x.Height / 2
x.Left = screen.Width / 2 - x.Width / 2
screen.MousePointer = 0

End Sub

Sub centerformLow (x As Form)

screen.MousePointer = 11
x.Top = (screen.Height * .95) - x.Height
x.Left = screen.Width / 2 - x.Width / 2
screen.MousePointer = 0

End Sub

Sub changeFile (sessionID As Long)

Dim sCommand As String

DDEPoke "ChangeFile", Format$(sessionID)

End Sub

Sub closeFile ()

DDEPoke "CloseFile", ""

End Sub

Sub copyOleItem (itemID As Long)

Dim sCommand As String

DDEPoke "CopyOleItem", Format$(itemID)

End Sub

Function countItems (items As String) As Integer

Dim tempList As String
Dim found As Integer
Dim ct As Integer

tempList = items
found = 1
ct = 1

While found <> 0
found = InStr(tempList, ",")
If found <> 0 Then
ct = ct + 1
tempList = Mid$(tempList, found + 1)
End If
Wend

countItems = ct

End Function

Function createFolder (folderType As Integer, folderName As String) As Long

Dim srVal As String
Dim sCommand As String

sCommand = Trim$(Str$(folderType)) + "," + folderName

srVal = DDERequest("CreateFolder", sCommand)

createFolder = Val(stripQuotes(srVal))

End Function

Function CreateItem (sText As String, fldID As Long, sValue As String) As Long

Dim srVal As String
Dim sCommand As String

sCommand = sText

If fldID <> 0 Then
sCommand = sCommand + "," + Format$(fldID)
sCommand = sCommand + "," + sValue
End If

srVal = DDERequest("CreateItem", sCommand)

CreateItem = Val(stripQuotes(srVal))

End Function

Sub DDEPoke (szCommand As String, szData As String)

screen.ActiveForm.DDE.LinkTopic = TOPIC_NAME
screen.ActiveForm.DDE.LinkItem = szCommand
screen.ActiveForm.DDE.Text = szData
screen.ActiveForm.DDE.LinkMode = DDE_MODE_MANUAL

screen.ActiveForm.DDE.LinkPoke

screen.ActiveForm.DDE.LinkMode = DDE_MODE_NONE

End Sub

Function DDERequest (szCommand As String, szData As String) As String

Dim sTemp As String

On Error Resume Next

If szData = "" Then
screen.ActiveForm.DDE.LinkTopic = TOPIC_NAME
screen.ActiveForm.DDE.LinkMode = DDE_MODE_MANUAL
screen.ActiveForm.DDE.LinkItem = szCommand
screen.ActiveForm.DDE.Text = ""

screen.ActiveForm.DDE.LinkRequest
sTemp = screen.ActiveForm.DDE.Text
screen.ActiveForm.DDE.LinkMode = DDE_MODE_NONE
Else
screen.ActiveForm.DDE.LinkTopic = TOPIC_NAME
screen.ActiveForm.DDE.LinkMode = DDE_MODE_MANUAL
screen.ActiveForm.DDE.LinkItem = szCommand
szData = szCommand + "," + szData

screen.ActiveForm.DDE.LinkExecute szData
'screen.ActiveForm.DDE.LinkMode = DDE_MODE_NONE
'screen.ActiveForm.DDE.LinkTopic = TOPIC_NAME
'screen.ActiveForm.DDE.LinkMode = DDE_MODE_MANUAL
screen.ActiveForm.DDE.LinkItem = "LastResult"
screen.ActiveForm.DDE.Text = ""

screen.ActiveForm.DDE.LinkRequest
sTemp = screen.ActiveForm.DDE.Text
screen.ActiveForm.DDE.LinkMode = DDE_MODE_NONE
End If

DDERequest = sTemp

End Function

Function eccoIsRunning () As Integer

Dim sTemp As String

sTemp = DDERequest("GetVersion", "")

If sTemp = "_DDE_ERROR_" Then
eccoIsRunning = False
Else
eccoIsRunning = True
End If

End Function

Function getCSVItem (ByVal csv As String, ByVal item As Integer) As String

Dim comma As Integer

While item > 1
comma = InStr(csv, ",")

If comma = 0 Then
csv = ""
Else
csv = Mid$(csv, comma + 1)
End If

item = item - 1
Wend

comma = InStr(csv, ",")
If comma > 0 Then
csv = Left$(csv, comma - 1)
End If

getCSVItem = csv

End Function

Title: Re: Visual Basic example Code for Ecco DDE API (2)
Post by Admin on 05/01/07 at 03:21:07

Function getEccoVers () As String

Dim temp As String
Dim srVal As String

srVal = DDERequest("GetVersion", "")

temp = getCSVItem(srVal, 1) + "."
temp = temp + getCSVItem(srVal, 2) + "."
temp = temp + getCSVItem(srVal, 3)

getEccoVers = temp

End Function

Function getFolderItems (fldID As Long, sort As String, crtra As String, crVal As String) As String

Dim srVal As String
Dim sCommand As String

'--------------------------
' Build the command string
'
sCommand = Format$(fldID)

If sort <> DDE_ST_DEFAULT Then
sCommand = sCommand + "," + sort
End If

If crtra <> DDE_CR_NOCRITERIA Then
sCommand = sCommand + "," + crtra + "," + Chr$(34) + crVal + Chr$(34)
End If

'-------------------------
' Send the DDE Request
'
srVal = DDERequest("GetFolderItems", sCommand)

getFolderItems = srVal

End Function

Function getFolderName (folderID As Long) As String

Dim srVal As String
Dim sCommand As String

sCommand = "GetFolderName," + Format$(folderID)

srVal = DDERequest(sCommand, "")

getFolderName = stripQuotes(srVal)

End Function

Function getFoldersByName (folderName As String) As String

Dim srVal As String
Dim sCommand As String

sCommand = folderName

srVal = DDERequest("GetFoldersByName", sCommand)

getFoldersByName = srVal

End Function

Function getFoldersByType (folderType As Integer)

Dim srVal As String
Dim sCommand As String

sCommand = "GetFoldersByType," + Format$(folderType)

srVal = DDERequest(sCommand, "")

getFoldersByType = srVal

End Function

Function getFolderType (folderID As Long) As Integer

Dim srVal As String
Dim sCommand As String

sCommand = "GetFolderType," + Format$(folderID)

srVal = DDERequest(sCommand, "")

getFolderType = Val(stripQuotes(srVal))

End Function

Function getFolderValues (itemID As Long, folderID As Long) As String

Dim srVal As String
Dim sCommand As String

sCommand = "GetFolderValues," + Format$(itemID)
sCommand = sCommand + Chr$(13) + Format$(folderID)

srVal = DDERequest(sCommand, "")

getFolderValues = srVal

End Function

Function getItemFolders (itemID As Long) As String

Dim srVal As String
Dim sCommand As String

sCommand = "GetItemFolders," + Format$(itemID)

srVal = DDERequest(sCommand, "")

getItemFolders = srVal

End Function

Function getItemParents (itemID As Long) As String

Dim srVal As String
Dim sCommand As String

sCommand = "GetItemParents," + Format$(itemID)

srVal = DDERequest(sCommand, "")

getItemParents = srVal

End Function

Function getItemSubs (depth%, itemID&) As String

Dim srVal As String
Dim sCommand As String

sCommand = "GetItemSubs," + Format$(depth)
sCommand = sCommand + "," + Format$(itemID)

srVal = DDERequest(sCommand, "")

getItemSubs = srVal

End Function

Function getItemText (itemID As Long) As String

Dim srVal As String
Dim sCommand As String

sCommand = "GetItemText," + Format$(itemID)

srVal = DDERequest(sCommand, "")

getItemText = srVal

End Function

Function getItemType (itemID As Long) As Integer

Dim srVal As String
Dim sCommand As String

sCommand = "GetItemType," + Format$(itemID)

srVal = DDERequest(sCommand, "")

getItemType = Val(stripQuotes(srVal))

End Function

Function getSelection () As String

Dim sCommand As String

sCommand = "GetSelection"

getSelection = DDERequest(sCommand, "")

End Function

Sub insertItem (itemID As Long, flags As String, itemList As String)

Dim sCommand As String

sCommand = Format$(itemID) + "," + flags + "," + itemList

DDEPoke "InsertItem", sCommand

End Sub

Function newEccoFile () As Long

Dim srVal As String
Dim sCommand As String

sCommand = "NewFile"

srVal = DDERequest(sCommand, "")

newEccoFile = Val(srVal)

End Function

Function openEccoFile (sPath As String) As Long

Dim srVal As String

srVal = DDERequest("OpenFile", sPath)

openEccoFile = Val(srVal)

End Function

Function pasteOleItem (flags As Integer, fldID As Long, sValue As String) As Long

Dim srVal As String
Dim sCommand As String

sCommand = "PasteOleItem," + Format$(flags)

If fldID <> 0 Then
sCommand = sCommand + "," + Format$(fldID)
sCommand = sCommand + "," + sValue
End If

srVal = DDERequest(sCommand, "")

pasteOleItem = Val(stripQuotes(srVal))

End Function

Sub removeItems (itemID&)

Dim sCommand As String

DDEPoke "RemoveItem", Format$(itemID)

End Sub

Sub saveFile (Path As String)

Dim sCommand As String

DDEPoke "SaveFile", Path

End Sub

Sub setFolderName (folderID As Long, sText As String)

Dim sCommand As String

sCommand = Format$(folderID) + "," + sText

DDEPoke "setFolderName", sCommand

End Sub

Sub setFolderValues (itemID As Long, fldID As Long, fldValue As String)

Dim sCommand As String

sCommand = Format$(itemID) + Chr$(13)
sCommand = sCommand + Format$(fldID) + Chr$(13)
sCommand = sCommand + fldValue

DDEPoke "SetFolderValues", sCommand

End Sub

Title: Re: Visual Basic example Code for Ecco DDE API (3)
Post by Admin on 05/01/07 at 03:22:10

Sub setItemText (itemID As Long, sText As String)

Dim sCommand As String

sCommand = Format$(itemID) + "," + sText

DDEPoke "SetItemText", sCommand

End Sub

Function stripQuotes (item As String) As String

Dim QUOTE As String
Dim temp As String
Dim x As Integer

QUOTE = Chr$(34)

'remove surrounding quotes
If Left$(item, 1) = QUOTE Then item = Right$(item, Len(item) - 1)
If Right$(item, 1) = QUOTE Then item = Left$(item, Len(item) - 1)

'change double quotes to single quotes
x = InStr(item, QUOTE + QUOTE)
While x
temp = item
item = Left$(temp, x)

If x + 2 < Len(temp) Then
item = item + Mid$(temp, x + 2)
End If

x = InStr(item, QUOTE + QUOTE)
Wend

stripQuotes = item

End Function