|
FoxProFoxPro Developer's Conference '94 |
Session 241
DDE/OLE
mit FoxPro
Kurt Zander
Papst GmbH
DDEData - Einfacher FoxPro DDE-Server
#DEFINE sCRLF CHR(13) + CHR(10)
#DEFINE sTAB CHR(9)
#DEFINE SVR_NAME "DDEData"
** Alle Elemente sind mit .F. vorbelegt
PUBLIC ARRAY aiCh[100] && Array für die Kanäle
** Einrichten des Servers mittels eines Dienstnamens, hier (und meistens)
** der Name der EXE-Datei. Der Dienstname darf maximal 8 Zeichen lang sein
=DDESetService(SVR_NAME, "define")
** als nächstes kommen die Angaben der unterstützten DDE-Aktionen des
** Servers
** Sucht Daten oder führt, wie in diesem Programm, eine Abfrage
** des Client aus. Ist eine Abfrage erfolgreich, wird die Funktion
** DDEPoke() zum Senden der Daten an die andere Anwendung benutzt
=DDESetService(SVR_NAME, "request", .T.)
** Aktualisiert das angegebene Element - hier den Datensatz - mit dem
** übergebenen Wert
=DDESetService(SVR_NAME, "poke", .T.)
** Erlaubt die Ausführung des übergebenen FoxPro-Befehles - hier nicht
** vorgesehen
=DDESetService(SVR_NAME, "execute", .T.)
** Verwendet die Funktion DDEPoke() zum Informieren des Clients über
** Änderungen oder zum Senden aktualisierter Daten an die andere An-
** wendung, wenn sich das Element (z.B. der Datensatz) geändert hat
=DDESetService(SVR_NAME, "advise", .F.)
** Einrichten des Themas für den Client. Neben dem Dienstnamen wird das
** Thema (Topic) angegeben, mit dem die andere Anwendung die Konversa-
** tion starten kann. Hier wird eine allgemeine Rückruffunktion einge-
** richtet, so daß das Thema als Nullstring übergeben wird.
** Der 3. Parameter bestimmt den Namen der Rückruffunktion, also der
** Routine, die die Konversation auswertet und Stati oder Daten zurück-
** gibt. Wird der dritte Parameter weggelassen, wird das Thema freige-
** geben.
=DDESetTopic(SVR_NAME, "", "cbDataTopic")
** in einem Cleanup-Bereich muß auf jeden Fall mit der Funktion
** DDESetService("DDEData", "release")
** der Dienst beendet werden
RETURN
** EoP DDEData
****************************************************************************
* cbDataTopic - Rückruf für Tabellen-, Abfrage- oder SQL-Themen
*
* Gültige Themen:
* <database>;TABLE <table name>
*
* z.B. "D:\ADRESSEN;TABLE Adressen.Dbf"
*
* Andere Themen verursachen ein Fehlschlagen von INITIATE
*
* Gültige Elemente:
* All - alle Daten, einschließlich Feldnamen
* Data - alle Daten, ohne Feldnamen
* FieldNames - eine Liste der Feldnamen
* NextRow - die nächste Zeile Daten
* PrevRow - die vorherige Zeile Daten
* FirstRow - die erste Zeile Daten
* Lastrow - die letzte Zeile Daten
* FieldCount - die Anzahl der Felder in der Tabelle
* nn - Zurückzugebende Zeilennummer
* mm-nn Zurückzugebender Zeilenbereich
*
* Eine Sendeanforderung (DDEPoke) erwartet den Feldnamen als
* das Element und die neuen Daten für dieses Feld.
* Andere Sendeanforderungen werden nicht ausgeführt.
****************************************************************************
PROCEDURE cbDataTopic
**-----------------------------------------------------------------
** iChannel = die Kanalnummer des Client
** sAction = die Aktionsmöglichkeiten INITIATE, TERMINATE,
** REQUEST, EXECUTE, ADVISE, POKE
** sItem = der Elementenname (siehe oben unter gültige Elemente)
** sData = die Daten vom Clienten
** sFormat = das Format der Daten (z.B. CF_TEXT, CF_BITMAP usw.)
** iStatus = der Verknüpfungtyp (hotlink, coldlink)
**-----------------------------------------------------------------
PARAMETERS iChannel, sAction, sItem, sData, sFormat, iStatus
PRIVATE bResult, sDatabase, sRowType, sRowSrc, iTemp, sUpItem, sUpData
PRIVATE sResult, iTemp2, bEnabState
PRIVATE sTagTable, sTagSQL
** Diese Funktion aktiviert oder deaktiviert den weiteren DDE.
** Hier wird eine weitere Anfrage deaktiviert, bis die Bearbeitung der
** Anfrage erfolgt ist. Am Ende der Routine erfolgt die Aktivierung
=DDEEnabled(.F.)
sTagTable = ";TABLE" && muß in Großbuchstaben sein
bResult = .T. && assume Aktion erfolgreich
DO CASE
**------------------------------------------------------------------------
** Client hat ein Initiate abgesetzt (bei FoxPro selbst das DDEInitiate())
** Es wird nunmehr ausgewertet, ob im einzigen gültigen Thema
** 1. der Inhalt der Var sTagTable vorhanden ist
** 2. ob evtl. eine Pfadangabe vorhanden ist und
** 3. ob die angegebene Tabelle vorhanden ist.
**------------------------------------------------------------------------
CASE sAction = "INITIATE"
sUpData = UPPER(sData) && immer Großbuchstaben
IF (!sTagTable $ sUpData) && Thementeil nicht vorhanden?
bResult = .F. && Verbindung ist fehlgeschlagen
ELSE
iTemp = AT(sTagTable, sUpData) && Position des Thementeils
sDatabase = LTRIM(SUBSTR(sUpData, ;
1, iTemp-1)) && Pfadangabe
IF (!EMPTY(sDatabase)) && Pfadname vorhanden?
SET DEFAULT TO (sDatabase) && Verzeichnis setzen
ENDIF
sRowSrc = ALLTRIM(SUBSTR(sData, ;
iTemp + ;
LEN(sTagTable))) && Name der Tabelle
IF (!(FILE(sRowSrc) OR ;
FILE(sRowSrc+".DBF"))) && Tabelle nicht vorhanden?
bResult = .F. && Verbindung ist fehlgeschlagen
ELSE
** Festhalten der von den verschiedenen DDE-Kanälen
** genutzten Arbeitsbereiche.
iTemp = ASCAN(aiCh, .F.) && nächster freier Kanal
IF (iTemp = 0) && keiner mehr möglich?
bResult = .F. && Verbindung ist fehlgeschlagen
ELSE && ist noch was frei
aiCh[iTemp] = iChannel && Kanalnummer vom Client
USE (sRowSrc) IN (iTemp) AGAIN && öffne Tabelle
ENDIF
ENDIF
ENDIF
**------------------------------------------------------------------------
** Der Client hat eine Anfrage abgesetzt. In den meisten Programmen
** geschieht das durch ein DDE-Peek() oder bei FoxPro selbst durch die
** Funktion DDERequest(). Was abgefragt werden soll, wird durch den
** Parameter sItem (Elementenname) festgelegt.
**------------------------------------------------------------------------
CASE (sAction = "REQUEST")
iTemp = ASCAN(aiCh, iChannel) && welcher Arbeitsbereich?
IF (iTemp != 0) && ist dieser vorhanden?
SELECT (iTemp) && selektiere diesen
ENDIF
sUpItem = UPPER(sItem) && in Großbuchstaben
DO CASE && werte aus, welches Element
CASE (sUpItem = "FIELDNAMES")
sResult = sFldNames() && ermittle die Feldnamen
CASE (sUpItem = "FIELDCOUNT")
sResult = sFldCount() && Anzahl der Felder
CASE (sUpItem = "FIRSTROW")
GO TOP && zum Tabellenanfang
sResult = sRowData() && Daten als String aufbereitet
CASE (sUpItem = "LASTROW")
GO BOTTOM && zum Tabellenende
sResult = sRowData() && Daten als String aufbereitet
CASE (sUpItem = "NEXTROW")
IF (EOF()) && Tabellenende erreicht
bResult = .F. && Anfrage schlägt fehl
ELSE && sonst
SKIP && nächster Satz
sResult = sRowData() && Daten als String aufbereitet
ENDIF
CASE (sUpItem = "PREVROW")
IF (BOF()) && Tabellenanfang erreicht?
bResult = .F. && Anfrage schlägt fehl
ELSE && sonst
SKIP -1 && vorheriger Satz
sResult = sRowData() && Daten als String aufbereitet
ENDIF
CASE (sUpItem = "ALL")
sResult = sFldNames() + sAllData() && Feldnamen und alle Daten
CASE (sUpItem = "DATA")
sResult = sAllData() && alle Daten
CASE (VAL(sUpItem) <> 0) && eine Satzgruppe oder ein Satz
iFirst = MAX(1, ;
MIN(INT(VAL(sUpItem)), ;
RECCOUNT())) && ermittle die 1. Satznummer
IF ("-" $ sUpItem) && Von-Bis übergeben?
iLast = VAL(SUBSTR(sUpItem, ;
AT("-", sUpItem)+1))
iLast = MAX(1, ;
MIN(iLast, RECCOUNT()))
iLast = MAX(iFirst, iLast) && ermittle ersten und letzten
sResult = "" && Rückgabestring
GO iFirst && gehe zum "ersten"
FOR iTemp = iFirst TO iLast && arbeite Von - Bis ab
sResult = sResult + sRowData() && Daten als String aufbereitet
SKIP && nächster Satz
ENDFOR
ELSE && nur eine Satznummer übergeben
GO iFirst && gehe dort hin
sResult = sRowData() && Daten als String aufbereitet
ENDIF
OTHERWISE && alle anderen Anfragen
bResult = .F. && schlagen ganz einfach fehl
ENDCASE
** Die angeforderten Daten an die andere Anwendung senden, wenn die
** Anfrage erfolgreich war
IF (bResult)
** Die Parameter sind: die Kanalnummer des Client, der Elementenname
** und das ermittelte Resultat
=DDEPoke(iChannel, sItem, sResult)
ENDIF
**------------------------------------------------------------------------
** Der Client hat ein Ersetzen eines bestimmten Elementes angefordert
** In den meisten Programmen erfolgt dies durch eine DDE-Poke() Funktion.
** In diesem Falle soll durch Übergabe des Feldnamens (sItem) der Wert
** sData in das Feld übertragen werden
**------------------------------------------------------------------------
CASE (sAction = "POKE")
FOR iTemp = 1 TO FCOUNT() && evtl. alle Felder testen
IF (FIELD(iTemp) = UPPER(sItem)) && der übergebene Feldname?
iTemp = 0 && wegen der unteren Prüfung
REPLACE &sItem WITH ;
vCvtField(TYPE('&sItem'), ;
sData) && ersetze Feldinhalt
EXIT && verlasse Schleife
ENDIF
ENDFOR
IF (iTemp != 0) && Feld nicht vorhanden?
bResult = .F. && Anforderung ist fehlgeschlagen
ENDIF
**------------------------------------------------------------------------
** Der Client will die Verbindung zum übergegebenen Kanal aufheben.
** In den meisten Programmen erfolgt dies durch eine DDE-Terminate() Funk-
** tion.
**------------------------------------------------------------------------
CASE (sAction = "TERMINATE")
iTemp = ASCAN(aiCh, iChannel) && Kanal im Array eingetragen?
IF (iTemp != 0) && gefunden?
SELECT (iTemp) && selektiere Arbeitsbereich
USE && schließe Tabelle
aiCh[iTemp] = .F. && Arrayelement zurücksetzen
ENDIF
**------------------------------------------------------------------------
** Alle anderen Anfragen oder Anforderungen des Clients führen zum Fehl-
** schlag
**------------------------------------------------------------------------
OTHERWISE
bResult = .F.
ENDCASE
=DDEEnabled(.T.) && nächste Anfrage wieder möglich
RETURN (bResult) && das war es
** EoFu cbDataTopic()
***********************************************************************
* Hilfsfunktionen, die von cbDataTopic() aktiviert werden
***********************************************************************
FUNCTION sFldNames
PRIVATE sResult, iTemp
sResult = ""
FOR iTemp = 1 TO FCOUNT()
sResult = sResult ;
+ FIELD(iTemp) ;
+ sTAB && jeweils mit TAB terminiert
ENDFOR
sResult = SUBSTR(sResult, 1, LEN(sResult)-1) ;
+ sCRLF && alle Felder mit CrLf termin.
RETURN (sResult)
** EoFu sFldNames()
FUNCTION sFldCount
PRIVATE sResult
sResult = STR(FCOUNT())+sCRLF
RETURN (sResult)
** EoFu sFldCount()
FUNCTION sRowData
PRIVATE sResult, iTemp, avData
SCATTER MEMO TO avData
sResult = ""
FOR iTemp = 1 TO FCOUNT()
sResult = sResult ;
+ sCvtField(TYPE('avData[iTemp]'), avData[iTemp]) ;
+ sTAB
ENDFOR
sResult = SUBSTR(sResult, 1, LEN(sResult)-1) ;
+ sCRLF
RETURN (sResult)
** EoFu sRowData()
FUNCTION sAllData
PRIVATE sResult
sResult = ""
SCAN
sResult = sResult ;
+ sRowData()
ENDSCAN
RETURN (sResult)
** EoFu sAllData()
FUNCTION sCvtField
PARAMETERS sType, vValue
PRIVATE sTemp
DO CASE
CASE (INLIST(sType, 'C', 'M'))
sTemp = vValue
CASE (INLIST(sType, 'N', 'F'))
sTemp = ALLTRIM(STR(vValue,15))
CASE (sType = 'D')
sTemp = DTOC(vValue)
CASE (sType = 'L')
sTemp = IIF(vValue, 'JA', 'NEIN')
ENDCASE
RETURN (sTemp)
** EoFu sCvtField()
FUNCTION vCvtField
PARAMETERS sType, sValue
PRIVATE vTemp
DO CASE
CASE (INLIST(sType, 'C', 'M'))
vTemp = sValue
CASE (INLIST(sType, 'N', 'F'))
vTemp = VAL(sValue)
CASE (sType = 'D')
vTemp = CTOD(sValue)
CASE (sType = 'L')
vTemp = IIF(UPPER(ALLTRIM(sValue)) $ 'JA', .T., .F.)
ENDCASE
RETURN (vTemp)
** EoFu vCvtField()
** EoF DDEDATA.PRG **
DDE/OLE mit FoxPro
(c)1994 Kurt Zander