program rs485dde;
{$D Burster/Gernsbach RS485<->DDE-Schnittstelle h#s 02/03 -- 04/04}
{auch fr Gantner ISK100, auch fr Windows NT (wegen Zeitmessung)?}
{Ein beliebiger Kommandozeilenschalter deaktiviert den direkten Portzugriff
unter Windows 3.x/9x/Me und l„sst RS485DDE genauso wie unter NT arbeiten
* šberarbeitung 04/04 fr detaillierte Fehler-Ereignis-Liste; Wegfall
des About-Fensters, neue Programmstruktur mit permanentem Dialog
SYMBOL LEUCHTET BEI FEHLER ZU KURZ, ein T3 (maximale "Bedenkzeit") muss rein}
{$F-,A+,G+,K+,W-}
{$I-,Q-,R-,S-}
{$V+,B-,X+,T+,P+}
{$M $3000,$1000}
{$N-}
{$R rs485dde}
uses WinProcs,WinTypes,Win31,Ddeml,ToolHelp, WUtils,{Parser,}Tray16;
const
AppName='RS485DDE'; {Fensterklassenname}
HelpFileName='RS485DDE.HLP';
FLASH=200; {ms Aufblitzen bei Transaktion}
{************* Hauptprogramm *************************}
var
DdeHelpString: array[0..1024] of Char; {zum Zusammensetzen}
const
MAXCOM=3; {Anzahl untersttzter Schnittstellen -1}
QUEUESIZE=80; {Schlangengr”áe bei OpenComm, = max. Stringl„nge}
DdeLastSystem=4; {Anzahl der System-Items}
DefT=20; {Standard-TimeOut fr T1 und T2 [ms], COM-Port ist blockiert}
WM_IconChange=WM_User+101;
DdeSystemS: array[0..DdeLastSystem] of PChar=(
'System','Topics','Formats','Help','SysItems');
{System-Item-Stringkonstanten}
DdeStrings:array[0..DdeLastSystem] of PChar=(nil,
'<COMx parameters timeouts>','CF_TEXT',
DdeHelpString,
'Topics Formats Help SysItems');
{Stringkonstanten als Antwort auf Anfragen auf System-Items}
DdeService='RS485';
var
Inst: LongInt; {Instanz-Variable ("Handle"), GLOBAL}
ServiceHsz: Hsz; {Stringhandle fr Service (RS485)}
{ DataHsz: array[0..DdeNumData] of Hsz; {Stringhandles fr normale Items}
SysHsz: array[0..DdeLastSystem]of Hsz; {System-Stringhandles}
SysConnections: Integer; {ist mit Null initialisiert}
DdeConnections: array[0..MAXCOM] of Integer;
{Anzahl aktiver Verbindungen pro COM-Port, Index=Cid von OpenComm}
Talking: array[0..MAXCOM] of Byte; {TRUE solange Daten nicht gelesen!}
ComTimers: array[0..MAXCOM] of Word;
{Zeitmarken der letzten Kommunikation, wichtig zur Einhaltung von Pausen}
{Rechenzeit-Hergabe und Reentranz-Aufl”sung ist eingebaut (via CBR_Block)}
PortAccess: Boolean; {=false}
{$IFDEF HaveWindow}
var
MainWnd: HWnd;
Icons: array[0..3] of HIcon; {4 Icons fr ruhend, verbunden, Fehler, OK}
CurIcon: Integer;
Statistik: array[0..3] of Word; {Zugriffsz„hler, Indizes:
0=DDE-Verbindungen inklusive SYSTEM, 1=DDEPokes+DDERequests (alle),
2=RS485-Fehler (Format, Prfsumme), 3=RS485-Okay}
Listbox: HWnd;
{************* Unterprogramme *************************}
procedure IncStatistik(index,add:Integer);
begin
if add<>0 then Inc(Statistik[index],add) else Statistik[index]:=0;
SetDlgItemInt(MainWnd,101+index,Statistik[index],false);
end;
procedure AddError(nr: Integer; src:PChar);
var
s: TS255;
i: Integer;
begin
i:=LoadString(Seg(HInstance),nr,s,sizeof(s));
if src<>nil then begin
lstrcpy(s+i,' (');
Inc(i,2);
Inc(i,EscapeStr(src,lstrlen(src),s+i,sizeof(s)-i-1));
lstrcpy(s+i,')');
end;
i:=SendMessageP(Listbox,LB_AddString,0,@s);
SendMessage(Listbox,LB_SetCurSel,i,0);
if i>1000
then SendMessage(Listbox,LB_DeleteString,0,0); {„ltesten Fehler l”schen}
end;
procedure ChangeDdeIcon(NewIcon:Integer);
var
Msg:TMsg;
begin
if NewIcon>=2 then begin
IncStatistik(NewIcon,1);
SetTimer(MainWnd,102,FLASH,nil); {Timer neu starten}
end;
if CurIcon=NewIcon then exit;
CurIcon:=NewIcon;
PeekMessage(Msg,MainWnd,WM_IconChange,WM_IconChange,PM_Remove);
PostMessage(MainWnd,WM_IconChange,NewIcon,0);
end;
function GetDdeConnections:Integer; {liefert nicht die SYSTEM-Verbindungen!}
var
Cid,i: Integer;
begin
i:=SysConnections;
for Cid:=0 to MAXCOM do Inc(i,DdeConnections[Cid]);
GetDdeConnections:=i;
end;
procedure ChangeDdeDisplay;
var
Cid: Integer;
vsrec:record
s: PChar;
i: Integer;
end;
s: TS31;
begin
vsrec.s:=WUtils.StdMBoxTitle;
vsrec.i:=GetDdeConnections;
wvsprintf(s,'%s [%d]',vsrec);
SetWindowText(MainWnd,s);
ChangeDdeIcon(Integer(vsrec.i<>0));
end;
{$ELSE}
procedure AddError(nr:Integer; src:PChar); begin; end;
{$ENDIF}
procedure DdeError(Code:Integer);
begin
vMBox({$IFDEF HaveWindow}MainWnd{$ELSE}0{$ENDIF},102,0,Code);
end;
function CreateStringHandle(Str:PChar):Hsz;
var Stringhandle: Hsz;
begin
Stringhandle:=DdeCreateStringHandle(Inst,Str,CP_WinAnsi);
CreateStringHandle:=StringHandle;
if StringHandle=0 then DdeError(2);
end;
procedure FreeStringHandle(Stringhandle:Hsz);
begin
if Stringhandle<>0 then
DdeFreeStringHandle(Inst,StringHandle);
end;
function GetSystemNumber(Hsz2: Hsz; Fmt:Word):Integer;
var
I: Integer;
begin
GetSystemNumber:=0; {Kein Datum!}
if Fmt<>CF_Text then exit;
for I:=1 to DdeLastSystem do
if DdeCmpStringHandles(Hsz2,SysHsz[I])=0 then begin
GetSystemNumber:=I;
exit;
end;
end;
function GetPrecisTick:Word;
{wie GetTickCount, jedoch wirklich ms-genau;
WORD reicht fr Zeitdifferenzen von 1 Minute,
ein Kandidat fr WUtils?}
var
ti:TTimerInfo;
begin
InitStruct(ti,sizeof(ti));
TimerCount(@ti);
GetPrecisTick:=LongRec(ti.dwmsSinceStart).lo;
end;
procedure BeginCriticalSection; assembler;
asm mov ax,1681h
int 2Fh
end;
procedure EndCriticalSection; assembler;
asm mov ax,1682h
int 2Fh
end;
function Make_Summe(s:PChar; slen:Integer):Byte; assembler;
{Prfsumme ber die Zeichen des Strings berechnen,
Attach_Summe verl„sst sich auf ES und SI bei Rckgabe!}
asm les si,[s]
mov cx,slen
mov ah,0
jcxz @@e
cld
@@l: seges lodsb
add ah,al {AH = Summenz„hler}
loop @@l
@@e: xchg ah,al
end;
procedure Attach_Summe(s:PChar; slen:Integer); assembler;
{Prfsumme in Hex (2 Stellen) an String anh„ngen}
const
format: array[0..4] of Char='%02X';
asm les si,[s]
push es
push si
push [slen]
call Make_Summe
mov ah,0
push ax
push ds
push offset format
push es
push si
call wsprintf
add sp,5*2 {eigentlich unn”tigt, erledigt Returncode}
end;
function GetUD(Conv:HConv):LongInt;
{holt zugeortnetes COM-Handle und Umschaltzeit T2 aus Conv heraus}
var
ci: TConvInfo;
begin
DdeQueryConvInfo(Conv,QID_Sync,@ci);
GetUD:=ci.hUser;
end;
function SendRecv(Cid:Integer; T1: Word; s:PChar; slen:Integer;
T2: Word; buf:PChar; bufsize:Integer; TermBelow: Char):Integer;
{Sendet und empf„ngt String zum und vom RS485-Ger„t.
T1 ist die Zeit, die vor dem Senden bzgl. vorheriger šbertragung
zu warten ist.
Der Sendestring sollte mit einem Zeichencode <20h abgeschlossen sein
(=ASCII-Protokoll), slen=Stringl„nge, -1 fr nullterminiert;
der Empfang des Strings bricht ab bei Zeitberschreitung,
Puffer voll oder bei Empfang eines Zeichencodes < TermBelow.
T2 ist die maximale Wartezeit zwischen Senden und Empfang in ms.
Rckgabe: Anzahl empfangener Zeichen (auch bei TimeOut),
-1 bei Sendefehler, -2 bei Reentranzfehler.
Der gelesene String ist nicht nullterminiert!
Der Burster/Gernsbach RS485-Umsetzer Typ 5401-Z001 schaltet die
Datenrichtung mit Hilfe der RTS-Leitung um.
Deshalb muss dieses Programm unmittelbar nach der Ausgabe des letzten Bytes
RTS l”schen und nicht verz”gern, sonst gibt es Buskollisionen und verlorene
Datenbytes.
Wegen des dazu notwendigen Portzugriffs l„uft diese Warteschleife nicht
unter Windows NT; stattdessen arbeitet eine berechnete Warteschleife,
die den Umschaltzeitpunkt mit einer Zugabe von 1..2 ms sch„tzt.
Auch die Portabfrage selbst w„re nicht sicher vor Taskumschaltungen;
deshalb erfolgt eine Einrahmung in einen (hoffentlich funktionierenden)
"kritischen Abschnitt".
Der Gantner RS485-Umsetzer Typ ISK100 detektiert die Richtungsumschaltung
anhand des Sendesignals TxD (kompliziertere Schaltung).
Dieser Umsetzer l„uft daher problemlos auch unter Windows NT.}
label exi;
var
ret,bytesread: Integer;
bitper1000byte:Integer;
tic: Word;
DCB: TDCB;
ComStat: WinTypes.TComStat absolute DCB; {krzer als DCB}
ls_reg: Word absolute bytesread;
begin
Ret:=-2;
Inc(Talking[Cid]); {Hoffentlich atomar!}
if Talking[Cid]>1 then goto exi; {Keine verschachtelten Zugriffe!}
if slen=-1 then slen:=lstrlen(s);
ret:=-1;
GetCommError(Cid,ComStat); {"auftauen" bei Fehler}
ls_reg:=0; {Portzugriffe sind m”glich?}
if PortAccess then ls_reg:=Word(EscapeCommFunction(Cid,GetBaseIrq))+5;
if ComStat.cbInQue<>0 {"Verirrte" Zeichen gekommen?}
then ComTimers[Cid]:=GetPrecisTick; {Wartezeit neu starten}
FlushComm(Cid,1); {Empfangswarteschlange leeren}
GetCommState(Cid,DCB); {Baudrate fr TimeOut-Bestimmung}
bitper1000byte:=(((2+DCB.bytesize
+Integer(DCB.parity<>0))shl 1)+DCB.stopbits)*500;
while GetPrecisTick-ComTimers[Cid]<T1 do ShortYield; {T1 warten}
EscapeCommFunction(Cid,SetRTS); {RTS aktiv (nach -12V) setzen}
BeginCriticalSection; {Keine Taskumschaltung zulassen!}
WriteComm(Cid,s,slen); {Ab in die Warteschlange!}
tic:=GetPrecisTick; {Jetzt geht das Rennen los!}
if ls_reg>=$100 then repeat {Ja, hier wird Windows blockiert!}
if GetPrecisTick-tic > MulDiv(slen,bitper1000byte,DCB.baudrate)+1
then begin {wenn's mal wieder l„nger dauert}
EndCriticalSection;
EscapeCommFunction(Cid,ClrRTS);
FlushComm(Cid,0); {Sendewarteschlange leeren}
goto exi;
end;
until Port[ls_reg] and $60 = $60 {Hardware-Zugriff! Sender leer?}
else repeat
until GetPrecisTick-tic > MulDiv(slen,bitper1000byte,DCB.baudrate)+1;
EscapeCommFunction(Cid,ClrRTS); {RTS inaktiv (nach +12V) setzen}
EndCriticalSection; {Ab jetzt haben wir Zeit...}
ret:=0;
repeat {T2 und den Empfang der Bytes abwarten}
bytesread:=ReadComm(Cid,buf,bufsize);
Inc(ret,bytesread);
Inc(buf,bytesread);
Dec(bufsize,bytesread);
ShortYield; {Gut gemeint, aber ein Anlass zur Verschachtelung}
if bytesread<>0 then begin
ComTimers[Cid]:=GetPrecisTick; {nur wenn Zeichen kommen, akt.}
if Ord((buf-1)^)<Ord(TermBelow) then break; {eine Endekennung}
end;
until (bufsize=0) {Puffer voll}
or (GetPrecisTick-tic > MulDiv(slen+ret+1,bitper1000byte,DCB.baudrate)+T2);
exi:
Dec(Talking[Cid]);
SendRecv:=ret;
end;
type
PCid=^TCid;
TCid=record {Daten-Ensemble zur Speicherung an der DDE-Transaktion}
id: Integer; {Comm-ID 0..3}
t1,T2: Byte; {T1- und T2-TimeOut in ms}
end;
function DdeCallback(CallType,Fmt:Word; Conv:hConv; HSz1,HSz2:HSz;
Data:hDdeData; Data1,Data2: LongInt): hDdeData; export;
label set_ico;
const {zum Hinberretten nach XTYP_Connect_Confirm}
ConnectingC:TCid=(id:-1); {Zeitvorgaben unn”tig}
var
SendSum, EmpfSum, SRNaked: Boolean;
EmpfChar: Char;
Sum: Byte;
sp,sp2,sp3: PChar;
i,ec,ico: Integer;
C: TCid;
dcb,dcb2: TDcb;
S,buf: array[0..QUEUESIZE] of Char; {1 Byte extra fr Null lassen}
begin
DdeCallback:=0;
ico:=2; {von Fehlschlag ausgehen}
case CallType of
XTYP_Connect: begin
if DdeCmpStringHandles(Hsz1,SysHsz[0])=0 then begin {1. "system"}
end else begin
i:=DdeQueryString(Inst,Hsz1,s,sizeof(s),CP_WinAnsi); {2. "COMx"}
sp:=s; {Weil Kommata bei Netzwerk-DDE}
while i<>0 do begin { nicht erlaubt sind...}
if sp^='+' then sp^:=','; {alle Plus zu Komma wandeln}
Inc(sp); Dec(i);
end;
C.t1:=DefT;
C.t2:=DefT;
sp:=lstrchr(s,' ');
if sp=nil then begin {ohne Angabe der Baudrate usw.}
Val(s+3,C.id,ec);
if ec<>0 then begin AddError(1,s); exit; end;
Dec(C.id);
end else begin
sp2:=lstrchr(sp+1,' '); {TimeOut-Parameter}
if sp2<>nil then begin
sp2^:=#0;
sp3:=lstrchr(sp2+1,',');
if sp3<>nil then begin
sp3^:=#0;
Val(sp3+1,C.t2,ec); {getrennte Zeiten}
if ec<>0 then begin AddError(2,sp3+1); exit; end;
end;
Val(sp2+1,C.t1,ec);
if ec<>0 then begin
AddError(2,sp2+1); {falsche TimeOut-Zahl}
exit;
end;
if sp3=nil then C.t2:=C.t1; {gleiche Zeiten}
if C.t2=0 then begin AddError(2,nil); exit; end;
end;
if BuildCommDCB(s,dcb)<>0 then begin
AddError(3,s);
exit;
end;{mit Angabe der Baudrate}
C.id:=dcb.id;
end;
if Word(C.id)>MAXCOM then begin AddError(1,nil); exit; end;
if DdeConnections[C.id]<>0 then begin
if sp<>nil then begin
GetCommState(C.id,dcb2);
if memcmp(PChar(@dcb),PChar(@dcb2),sizeof(dcb))<>0 then begin
AddError(4,nil); {Mssen gleiche Parameter sein!}
exit;
end;
end;
end else begin
if sp<>nil then sp^:=#0; {Parameter abhacken}
C.id:=OpenComm(s,QUEUESIZE,QUEUESIZE);
if Word(C.id)>MAXCOM then begin
i:=5;
case C.id of
IE_Open: i:=6;
IE_NOpen: i:=7;
IE_Hardware: i:=8;
end;
AddError(i,s);
exit; {Bereits (woanders) ge”ffnet!}
end;
if (sp<>nil) and (SetCommState(dcb)<>0) then begin
CloseComm(C.id);
AddError(9,sp);
exit;
end;
end;
ConnectingC:=C;
end;
DdeCallback:=1; {Verbindung okay!}
end;
XTYP_Connect_Confirm: begin
C:=ConnectingC;
ConnectingC.id:=-1;
DdeSetUserHandle(Conv,QID_Sync,LongInt(C)); {nachtr„gliche Zuordnung!}
if C.id>=0 then Inc(DdeConnections[C.id])
else Inc(SysConnections);
{$IFDEF HaveWindow}
ChangeDdeDisplay;
IncStatistik(0,1);
{$ENDIF}
end;
XTYP_Disconnect: begin
LongInt(C):=GetUD(Conv); {Deskriptor holen}
if C.id>=0 then begin
Dec(DdeConnections[C.id]);
if DdeConnections[C.id]=0 then CloseComm(C.id);
end else Dec(SysConnections);
{$IFDEF HaveWindow}
IncStatistik(0,-1);
ChangeDdeDisplay;
{$ENDIF}
end;
XTYP_Request: begin
(*Aufbau Request-Item:
Sende-String{:|;}Empfangs-Maske{|:|;} oder Sende-String*
: = normales Trennzeichen
; = Prfsumme anh„ngen (Sende-String) bzw. prfen (Empfangs-String)
Empfangs-Maske ist hier das erste erwartete Zeichen des Empfangs-Strings
(wird abgeschnitten, genauso wie die Prfsumme)
Das Request-Item wird von hinten geparst; der Sende-String darf deshalb
':' und ';' enthalten, auch die Empfangs-Maske darf ';' oder ':' sein
Die šbergabe von Sende-String* erm”glicht ungefilterte (Bin„r-)šbertragung
(z.B. Profibus, ModBus), der Stern wird abgeschnitten,
ggf. "\r" nicht vergessen! *)
{$IFDEF HaveWindow}
IncStatistik(1,1);
{$ENDIF}
if Fmt<>CF_Text
then begin AddError(10,nil); exit; end; {Kann nicht anders!}
LongInt(C):=GetUD(Conv); {Deskriptor holen}
if C.id>=0 then begin
SendSum:=false;
EmpfSum:=false;
SRNaked:=false;
i:=DdeQueryString(Inst,Hsz2,s,sizeof(s),CP_WinAnsi);
if i<2 then begin AddError(11,s); exit; end;
Dec(i);{auch ungefiltert mindestens 1 Zeichen}
EmpfChar:=s[i];
if EmpfChar='*' then SRNaked:=true
else begin
if i<3 then begin
AddError(11,s);
exit; {mindestens 4 Zeichen mssen's hier sein}
end;
if EmpfChar=';' then EmpfSum:=true;
if EmpfChar in [':',';'] then begin
Dec(i);
EmpfChar:=s[i];
end;
Dec(i);
case s[i] of
';': SendSum:=true;
':': ;
else AddError(12,s); exit; {Fehler im DDE-Request}
end;
if SendSum then begin
Attach_Summe(s,i);
Inc(i,2);
end;
s[i]:=#13; Inc(i);
end;
i:=SendRecv(C.id,C.t1,s,i,C.t2,buf,sizeof(buf),
Char(IfThenElse(SRNaked,$00,$20)));
if i=-2 then begin DdeCallback:=CBR_Block; exit; end;
if i<0 then begin AddError(13,nil); goto set_ico; end;
if SRNaked then sp:=buf {ungefiltert bergeben (auch Leerstring)}
else begin
if i<2 then begin
AddError(14,buf); {Mindestens 2 Zeichen mssen kommen!}
goto set_ico;
end;
if buf[0]<>EmpfChar then begin
AddError(15,buf);
goto set_ico; {Falsches Startzeichen}
end;
Dec(i);
if buf[i]<>#13 then begin
AddError(16,buf);
goto set_ico; {Falsches Endezeichen}
end;
buf[i]:=#0;
if EmpfSum then begin
if i<3 then begin
AddError(14,buf);
goto set_ico; {Mindestens 4 Zeichen mssen kommen!}
end;
Dec(i,2); {2 Zeichen hinten weniger}
s[0]:='$';
lstrcpy(s+1,buf+i);
buf[i]:=#0;
Val(s,Sum,ec);
if ec<>0 then begin
AddError(17,buf);
goto set_ico; {Falsche Zeichen in Prfsumme o.„.}
end;
if Make_Summe(buf,i)<>Sum then begin
AddError(18,buf);
goto set_ico; {Falsche Prfsumme}
end;
end;
sp:=buf+1; Dec(i);
end;
sp[i]:=#0; {fr DDE terminieren}
DdeCallback:=DdeCreateDataHandle(Inst,sp,i+1,0,hsz2,CF_Text,0);
Inc(ico); {Erfolg}
goto set_ico;
end; {SYSTEM-Thema}
i:=GetSystemNumber(hsz2,fmt);
if i<=0 then begin
AddError(19,nil);
exit;
end;
sp:=DdeStrings[i];
DdeCallback:=DdeCreateDataHandle(Inst,sp,lstrlen(sp)+1,0,hsz2,CF_Text,0);
end;
XTYP_Poke: begin
(*Aufbau Poke-Item:
Sende-String-Kopf{|:|;}
: = normales Trennzeichen (wirkungslos, auáer um : zu erm”glichen)
; = Prfsumme anh„ngen (Sende-String)
Sende-String-Kopf wird einfach um die Poke-Daten erg„nzt,
ggf. mit Prfsumme erg„nzt, und die ACK-Best„tigung vom Ger„t eingeholt.
Bei fehlender oder NACK-Best„tigung gibt's ein DDE_fNotProcessed. *)
{$IFDEF HaveWindow}
IncStatistik(1,1);
{$ENDIF}
if Fmt<>CF_Text
then begin AddError(10,nil); exit; end; {Kann nicht anders!}
LongInt(C):=GetUD(Conv); {Deskriptor holen}
if C.id<0 then begin
AddError(20,nil);
exit;
end;
i:=DdeQueryString(Inst,Hsz2,s,sizeof(s),CP_WinAnsi);
if i=0 then begin
AddError(11,nil);
exit;
end;
Dec(i);
SendSum:=false;
if s[i]=';' then SendSum:=true;
if not (s[i] in [':',';']) then Inc(i);
if Data<>0 then begin
lstrcpyn(s+i,DdeAccessData(Data,nil),sizeof(s)-3-i);
{Die Daten von DdeAccessData k”nnen keine Nullen enthalten,
weil die DDE-L„ngenangabe in 32er Stckelung kommt (getestet)}
DdeUnaccessData(Data);
Inc(i,lstrlen(s+i)); {neu durchz„hlen}
end;
if SendSum then begin
Attach_Summe(s,i);
Inc(i,2);
end;
s[i]:=#13; Inc(i);
i:=SendRecv(C.id,C.t1,s,i,C.t2,buf,sizeof(buf),' ');
if i=-2 then begin DdeCallback:=CBR_Block; exit; end; {Reentranz}
if i<0 then begin AddError(13,nil); goto set_ico; end;
if i=1 then case buf[0] of
#$06: begin
DdeCallback:=DDE_fAck;
Inc(ico); {Erfolg}
goto set_ico;
end;
#$15: begin
AddError(22,buf); {NAK}
goto set_ico;
end;
end else AddError(21,buf); {irgendetwas}
set_ico:
{$IFDEF HaveWindow}
ChangeDdeIcon(ico); {Erfolg oder Misserfolg anzeigen}
{$ENDIF}
DdeEnableCallback(Inst,0,EC_EnableAll); {blockierte neu starten}
end;
end;
end;
procedure DDEInit;
var
W: Word;
begin
if DdeInitialize(Inst,DdeCallBack,CBF_Skip_Registrations
or CBF_Skip_Unregistrations
or CBF_Fail_Executes
or CBF_Fail_Advises,0)<>DMLErr_No_Error
then DdeError(DMLErr_Sys_Error);
W:=LoadString(Seg(HInstance),106,DdeHelpString,256);
Inc(W,LoadString(Seg(HInstance),107,DdeHelpString+W,256));
LoadString(Seg(HInstance),108,DdeHelpString+W,256);
ServiceHsz:=CreateStringHandle(DdeService);
for W:=0 to DdeLastSystem do SysHsz[W]:=CreateStringHandle(DdeSystemS[W]);
if DdeNameService(Inst,ServiceHsz,0,DNS_Register)=0
then DdeError(3);
end;
procedure DdeDone;
var i:Integer;
begin
DdeNameService(Inst,ServiceHsz,0,DNS_Unregister);
for I:=DdeLastSystem downto 0 do
FreeStringHandle(SysHsz[i]);
FreeStringHandle(ServiceHsz);
DdeUninitialize(Inst);
end;
{$IFDEF HaveWindow}
var
traydata: TNotifyIconData;
MinSize: TPoint; {AusgangsgrӇe fr Dialogfenster}
ListPos: TPoint;
procedure ShellNotify;
begin
if not Shell_NotifyIcon(NIM_Modify,traydata) then begin
LongRec(traydata.uFlags).lo:=NIF_Icon or NIF_Tip or NIF_Message;
Shell_NotifyIcon(NIM_Add,traydata);
end;
end;
procedure GetMinSize;
var
wp:TWindowPlacement;
begin
wp.length:=sizeof(wp);
GetWindowPlacement(MainWnd,@wp);
MinSize.x:=wp.rcNormalPosition.right-wp.rcNormalPosition.left;
MinSize.y:=wp.rcNormalPosition.bottom-wp.rcNormalPosition.top;
GetWindowRect(Listbox,wp.rcNormalPosition);
ListPos:=PPoint(@wp.rcNormalPosition)^;
ScreenToClient(MainWnd,ListPos);
end;
function MainDlgProc(Wnd:HWnd; Msg,wParam:Word; lParam:LongInt):Bool; export;
var
lPar: LongRec absolute lParam;
P: TPoint;
m,sysm: HMenu;
s: TS31;
begin
MainDlgProc:=false;
case Msg of
WM_InitDialog: begin
MainWnd:=Wnd;
Listbox:=GetDlgItem(Wnd,105);
sysm:=GetSystemMenu(Wnd,false);
DeleteMenu(sysm,SC_Maximize,0);
LoadString(Seg(HInstance),111,s,sizeof(s)); {Hilfe}
InsertMenu(sysm,1,MF_ByPosition or MF_String,$1D0,s);
if Swap(Word(GetVersion))>=3*256+95 then begin
LoadString(Seg(HInstance),110,s,sizeof(s)); {In den Tray!}
InsertMenu(sysm,2,MF_ByPosition or MF_String,$1E0,s);
if CmdShow in [SW_Minimize,SW_ShowMinimized,SW_ShowMinNoActive]
then PostMessage(Wnd,WM_SysCommand,$1E0,0);
end;
GetMinSize; {Fokus NICHT setzen! Sonst wirkt ShowMinNoActive nicht}
end;
WM_GetMinMaxInfo: begin
PMinMaxInfo(lParam)^.ptMinTrackSize:=MinSize;
end;
WM_Size: if wParam=SIZE_Minimized then begin
if LongRec(traydata.cbSize).lo<>0 then ShowWindow(Wnd,SW_Hide);
end else begin
SetWindowPos(Listbox,0,0,0,
lPar.lo-8-ListPos.x,lPar.hi-8-ListPos.y,SWP_NoZOrder or SWP_NoMove);
end;
WM_Timer: begin
KillTimer(Wnd,102);
if CurIcon<>0 then ChangeDdeIcon(1);
end;
WM_IconChange: begin
lPar.lo:=Icons[wParam];
SetClassWord(Wnd,GCW_HIcon,lPar.lo);
InvalidateRect(Wnd,nil,true);
if LongRec(traydata.cbSize).lo<>0 then begin
LongRec(traydata.hIcon).lo:=lPar.lo;
LongRec(traydata.uFlags).lo:=NIF_Icon; {nur Icon „ndern}
ShellNotify;
end;
SendDlgItemMessage(Wnd,100,STM_SETICON,lPar.lo,0);
end;
WM_SetText: begin
if LongRec(traydata.cbSize).lo<>0 then begin
lstrcpy(traydata.szTip,PChar(lParam));
LongRec(traydata.uFlags).lo:=NIF_Tip; {nur Text „ndern}
ShellNotify;
end;
end;
WM_SysCommand: case wParam and $FFF0 of
$1E0: begin {In den Tray!}
LongRec(traydata.cbSize).lo:=sizeof(traydata);
LongRec(traydata.hwnd).lo:=Wnd;
LongRec(traydata.uID).lo:=110;
LongRec(traydata.uFlags).lo:=NIF_Icon or NIF_Tip or NIF_Message;
LongRec(traydata.uCallbackMessage).lo:=WM_User+100;
LongRec(traydata.hIcon).lo:=GetClassWord(Wnd,GCW_HIcon);
GetWindowText(Wnd,traydata.szTip,sizeof(traydata.szTip));
if Shell_NotifyIcon(NIM_Add,traydata)
and IsIconic(Wnd)
then ShowWindow(Wnd,SW_Hide);
end;
$1D0: WinHelp(Wnd,HelpFileName,HELP_Index,0);
end;
WM_User+100: case lParam of
WM_LButtonDown: begin
ShowWindow(Wnd,SW_Restore);
end;
WM_RButtonDown: begin
m:=LoadMenu(Seg(HInstance),MakeIntResource(100));
sysm:=GetSubMenu(m,0);
GetCursorPos(P);
TrackPopupMenu(sysm,TPM_RightAlign or TPM_RightButton,
P.x,P.y,0,Wnd,nil);
DestroyMenu(m);
end;
end;
WM_Command: case wParam of {kommen nur vom System-Tray!}
2: ShowWindow(Wnd,SW_Minimize); {besser als gar nichts}
100: begin {normales Fenster!}
if not IsWindowVisible(Wnd) then ShowWindow(Wnd,SW_Minimize);
Shell_NotifyIcon(NIM_Delete,traydata);
LongRec(traydata.cbSize).lo:=0; {auch knftig deaktivieren}
end;
106: begin {Rcksetzen+L”schen}
SendMessage(Listbox,LB_ResetContent,0,0);
for lPar.lo:=1 to 3 do IncStatistik(lPar.lo,0);
end;
900: WinHelp(Wnd,HelpFileName,HELP_Index,0);
999: ShowWindow(Wnd,SW_Restore);
end;
WM_Close: begin
if (GetDdeConnections>0)
and (MBox1(Wnd,109{WarnClose},MB_IconQuestion or MB_YesNo or MB_Sound,
PChar(GetDdeConnections))<>IDYes)
then exit;
if LongRec(traydata.cbSize).lo<>0
then Shell_NotifyIcon(NIM_Delete,traydata);
WinHelp(Wnd,HelpFileName,HELP_Quit,0);
DestroyWindow(Wnd);
end;
WM_Destroy: PostQuitMessage(0);
end;
end;
const
wc: TWndClass=(
style: {CS_VRedraw or CS_HRedraw}CS_DblClks;
lpfnWndProc: @DefDlgProc{@MainWndProc};
cbClsExtra: 0;
cbWndExtra: DlgWindowExtra;
hInstance: Seg(HInstance);
hIcon: 0;
hCursor: 0;
hbrBackground: COLOR_Background+1;
lpszMenuName: nil;
lpszClassName: AppName);
var
Msg:TMsg;
i: Integer;
AppTitle: TS31;
begin
if HPrevInst<>0 then begin
SetActiveWindow(MemW[HPrevInst:Ofs(MainWnd)]);
exit;
end;
for i:=0 to HIGH(Icons) do
Icons[i]:=LoadIcon(Seg(HInstance),MakeIntResource(100+i));
wc.hIcon:=Icons[0];
wc.hCursor:=LoadCursor(0,IDC_Arrow);
RegisterClass(wc);
CreateDialog(Seg(HInstance),MakeIntResource(100),0,@MainDlgProc);
ShowWindow(MainWnd,SW_ShowMinNoActive);
GetWindowText(MainWnd,AppTitle,sizeof(AppTitle));
{$ELSE}
var
Msg:TMsg;
const
AppTitle='RS485<->DDE';
begin
if HPrevInst<>0 then exit;
{$ENDIF}
WUtils.StdMBoxTitle:=AppTitle;
if (lstrlen(CmdLine) =0) {Portzugriff erlaubt?}
and (GetWinFlags and WF_WinNT =0) {Portzugriff m”glich?}
then PortAccess:=true;
DdeInit;
while GetMessage(Msg,0,0,0) do begin
{$IFDEF HaveWindow}
if IsDialogMessage(MainWnd,Msg) then continue;
{$ENDIF}
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
DdeDone;
{$IFDEF HaveWindow}
for i:=0 to HIGH(Icons) do DestroyIcon(Icons[i]);
{$ENDIF}
end.
| Detected encoding: UTF-8 | 0
|