Quelltext /~heha/messtech/d2s.zip/SRC/D2S.PAS

program d2s;
{$D DDE<->TCP-Socket-Umsetzer h#s 05/04}
{$F-,A+,G+,K+,W-}
{$I-,Q-,R-,S-}
{$V+,B-,X+,T+,P+}
{$N-}

{$IFDEF Win32}
{$R d2s32}
uses Windows,Messages,Ddeml,ShellApi,WinSock,CommDlg, WUtils32;
type
 TChar=Char;
{ UInt=Word;}
{$ELSE}
{$R d2s}
{$M $3000,$1000}
uses WinProcs,WinTypes,Win31,Ddeml,ShellApi,CommDlg, WinSock,WUtils,Tray16;
type
 TChar=Char;
{ UInt=Word;}
{$ENDIF}

const
 AppName:	array[0..3] of TChar='D2S';
 HelpFileName:	array[0..7] of TChar='D2S.HLP';
 FLASH=200;			{ms Aufblitzen aktive Verbindung}

{************* Hauptprogramm *************************}
const
 WM_IconChange=WM_User+1;
 WM_ContinueInit=WM_User+2;
 WM_Accept=WM_User+15;
 WM_Recv=WM_User+16;
 WM_Tray=WM_USER+17;

type
 EStatistik=(E_CLIENT,E_SERVER,E_REQUEST,E_POKE,E_EXEC,E_ADVISE,E_ERROR);
 SStatistik=set of EStatistik;
 PStatistik=^TStatistik;
 TStatistik=record
  case integer of
  0: (clients,servers,requests,pokes,execs,advises,errors: UInt);
  1: (all: array[EStatistik] of UInt);
 end;

var
 Inst: LongInt;			{Instanz-Variable ("Handle"), GLOBAL}
 AppTitle: TS31;		{='DDE<->Socket'}

 MainWnd: HWnd;
 Listbox: HWnd;
 SetupDlg: HWnd;		{dieser ist nicht-modal...}
 KBHand: HWnd;
 d2s_port: UInt;
 Icons: array[0..3] of HIcon;	{4 Icons fr ruhend, verbunden, Fehler, OK}
 CurIcon: Integer;
 Statistik: record	{Zugriffszhler}
  ddeserv,tcpserv:TStatistik;
 end;
 Auswahl: Integer;
const
 AcceptSock: TSocket=INVALID_SOCKET;		{Fr eingehende Verbindungen}

{************* Unterprogramme *************************}

procedure ChangeDdeIcon(NewIcon:Integer);
 var
  Msg:TMsg;
 begin
  if NewIcon>=2 then begin
   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;

procedure ChangeDdeDisplay;
 var
  vsrec:record
   s: PChar;
   i: UInt;
  end;
  s: TS31;
 begin
  vsrec.s:=AppTitle;
  vsrec.i:=Statistik.ddeserv.clients+Statistik.tcpserv.clients;
  wvsprintf(s,'%s [%u]',vsrec);
  SetWindowText(MainWnd,s);
  if vsrec.i<>0 then begin
   if CurIcon=0 then ChangeDdeIcon(1);	{Nur wenn nicht schon aktiv}
  end else begin
   ChangeDdeIcon(0);
  end;
 end;

procedure IncStatistik(was:PUInt; um:Integer);
 var
  Stat,tcpStat: UInt;
  PStat: PUint;
  e: EStatistik;
  match,tcpmatch: Boolean;
 begin
  if was<>nil then begin
   if um=0 then exit;
   Inc(was^,um);
	{Ab jetzt so selten wie mglich SetDlgItemInt rufen}
   if (was=@Statistik.ddeserv.clients)
   or (was=@Statistik.tcpserv.clients)
   then ChangeDdeDisplay;
  end;
  if Auswahl=-1 then exit;	{Hauptfenster unsichtbar}
  for e:=LOW(e) to HIGH(e) do begin
   PStat:=@Statistik.ddeserv.all[e];
   Stat:=PStat^;
   match:=was=PStat;
   PStat:=@Statistik.tcpserv.all[e];
   tcpStat:=PStat^;
   tcpmatch:=was=PStat;
   case Auswahl of
    0: begin Inc(Stat,tcpStat); match:=match or tcpmatch; end;	{Addieren}
    2: begin Stat:=tcpStat; match:=tcpmatch; end;		{Ersetzen}
   end;
   if (was=nil) or match then SetDlgItemInt(MainWnd,102+UInt(e),Stat,false);
  end;
 end;

procedure AddError(nr: Integer; src:PChar);
 var
  s: TS255;
  i,j: Integer;
 begin
  i:=LoadString({$IFNDEF Win32}Seg{$ENDIF}(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);
  j:=SendMessage(Listbox,LB_GetCurSel,0,0);
	{Automatisch rollen solange Anwender nicht darin schmkert}
  if j=i-1 then SendMessage(Listbox,LB_SetCurSel,i,0);
  if i>1000 then begin
   SendMessage(Listbox,LB_DeleteString,0,0); {ltesten Fehler lschen}
   if j=0 then SendMessage(Listbox,LB_SetCurSel,0,0);
  end;
 end;

procedure DdeError(Code:Integer);
 var
  s:TS15;
 begin
  wvsprintf(s,'%d',Code);
  AddError(102,s);
 end;

procedure SockError(Code:Integer);
 var
  vsrec:record
   i:Integer;
   p:PChar;
  end;
  s:TS63;
 begin
  LoadString({$IFNDEF Win32}Seg{$ENDIF}(HInstance),Code,s,HIGH(s)+1);
  vsrec.i:=Code;
  vsrec.p:=s;
  vMBox(MainWnd,103,MB_OK or MB_IconExclamation,vsrec);
 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;

type
 PArgv=^TArgv;
 TArgv=array[0..10000] of PChar;
function split(s:PChar; d: Char; argc:PInteger):PArgv;
 var
  s0: PChar;
  argv: PArgv;
  i: Integer;
 begin
{ 1. count colums }
  s0:=s;
  i:=1;
  while s0^<>#0 do begin
   if s0^=d then Inc(i);
   s0:=AnsiNext(s0);
  end;
  if argc<>nil then argc^:=i;
{ 2. allocate memory }
{$IFDEF Win32}
  argv:=PArgv(LocalAlloc(LPTR,(i+1)*sizeof(PPChar)));
{$ELSE}
  argv:=Ptr(Seg(HInstance),LocalAlloc(LPTR,(i+1)*sizeof(PPChar)));
{$ENDIF}
  split:=argv;
{ 3. fill argv and split s }
  i:=0;
  repeat
   argv^[i]:=s;
   while (s^<>d) do begin
    if s^=#0 then exit;
    s:=AnsiNext(s)
   end;
   s0:=AnsiNext(s);
   s^:=#0;
   s:=s0;
   Inc(i)
  until false;
 end;

function SetAcceptPort(port:Word):Boolean;
 label ok;
 var
  sa: TSockAddrIn;
 begin
  SetAcceptPort:=false;
  if d2s_port=port then goto ok;
{neues Port, also neuer Accept-Socket}
  if AcceptSock<>INVALID_SOCKET then begin
   CloseSocket(AcceptSock);
  end;
  AcceptSock:=Socket(AF_INET,SOCK_STREAM,IPPROTO_TCP);
  if AcceptSock=INVALID_SOCKET then exit;	{kein Socket frei!}
  FillChar(sa,sizeof(sa),0);
  sa.sin_family:=PF_INET;
  sa.sin_port:=htons(port);
  if bind(AcceptSock,sa,sizeof(sa))<>0 then exit;
  listen(AcceptSock,5);
  if WSAAsyncSelect(AcceptSock,MainWnd,WM_Accept,FD_Accept)<>0 then exit;
  d2s_port:=port;
ok:
  SetAcceptPort:=true;
 end;

type
{ PIpRange=^TIpRange;}
 TIpRange=record
  a,e:DWord;
 end;

var
 IniFileName: TS255;
 LogNum: UInt;
 maxline: UInt;
 ranges: array[0..9] of TIpRange;
 DefDelim: array[0..9] of TChar;

procedure S2Range(var r:TIpRange; s:PChar);
 var
  hack: PChar;
  he: PHostEnt;
 begin
  hack:=lstrchr(s,'-');
  if hack<>nil then begin
   hack^:=#0;
  end;
  r.a:=ntohl(inet_addr(s));
  r.e:=r.a;
  if r.a=DWord(INADDR_NONE) then begin
   if hack<>nil then hack^:='-';	{mit Namen probieren}
   he:=PHostEnt(GetHostByName(s));
   if he=nil then exit;
   r.a:=ntohl(PDWord(he^.h_addr_list^)^);
   r.e:=r.a;
   exit;
  end;
  if hack=nil then exit;
  r.e:=ntohl(inet_addr(hack+1));
  hack^:='-';
 end;

{$IFDEF Win32}
function ValidRange(const r:TIpRange):Boolean;
 begin
  ValidRange:=(Cardinal(r.a)<=Cardinal(r.e)) and (r.e<>INADDR_None);
 end;
{$ELSE}
function ValidRange(const r:TIpRange):Boolean; assembler;
 asm	{da fehlen die vorzeichenlosen LongInts}
	les	di,[r]
	db	$66
	mov	ax,LongRec(es:TIpRange[di].a).lo
	db	$66
	mov	dx,LongRec(es:TIpRange[di].e).lo
	db	$66
	cmp	dx,ax
	jc	@@err
	db	$66
	inc	dx
	mov	al,TRUE
	jnz	@@ok
@@err:	mov	al,FALSE
@@ok:
 end;
{$ENDIF}

procedure Range2S(const r:TIpRange; s:PChar);
{Umwandlung in String, s muss 32 Zeichen Platz bieten!}
 begin
  lstrcpy(s,inet_ntoa({$IFDEF Win32}TInAddr{$ENDIF}(htonl(r.a))));
  if r.e=r.a then exit;
  lstrcat(s,'-');
  lstrcat(s,inet_ntoa({$IFDEF Win32}TInAddr{$ENDIF}(htonl(r.e))));
 end;

const
 stMain:	array[0..4] of TChar='Main';
 stWinPos:	array[0..7] of TChar='WinPos';
 stMaxLine:	array[0..8] of TChar='MaxLine';
 stDefDelim:	array[0..9] of TChar='DefDelim';
 stPort:	array[0..4] of TChar='Port';
 stAcceptList:	array[0..10]of TChar='AcceptList';
 stLog:		array[0..3] of TChar='Log';
 stAutostart:	array[0..9] of TChar='Autostart';
procedure LoadConfig;
 var
  i:Integer;
  key:TS7;
  buf:TS255;
 begin
  maxline:=GetPrivateProfileInt(stMain,stMaxLine,4096,IniFileName);
  GetPrivateProfileString(stMain,stDefDelim,':',
    DefDelim,HIGH(DefDelim)+1,IniFileName);
  SetAcceptPort(GetPrivateProfileInt(stMain,stPort,2000,IniFileName));
  for i:=0 to HIGH(ranges) do begin
   {$IFDEF Win32}wsprintf1(key,'%d',PChar(i)){$ELSE}wvsprintf(key,'%d',i){$ENDIF};
   if (GetPrivateProfileString(stAcceptList,key,'',buf,HIGH(buf)+1,
     IniFileName)<>0) then S2Range(ranges[i],buf)
   else ranges[i].a:=DWord(-1);
  end;
 end;

function strtol(s:PChar;se:PPChar):Integer;
 label ende;
 var
  r,e:Integer;
  c: Char;
  sp: PChar;
 begin
  Val(s,r,e);	{1. Versuch}
  if e=0 then begin sp:=s+lstrlen(s); goto ende; end;
  sp:=s+e-1;
  c:=sp^; sp^:=#0;
  Val(s,r,e);	{2. Versuch}
  sp^:=c;
ende:
  if se<>nil then se^:=sp;
  strtol:=r;
 end;

procedure LoadWinPos;
 var
  wp:TWindowPlacement;
  sp: PChar;
  buf:TS63;
 begin
  if GetPrivateProfileString(stMain,stWinPos,'',buf,HIGH(buf)+1,IniFileName)
    =0 then exit;
  wp.length:=sizeof(wp);
  GetWindowPlacement(MainWnd,@wp);
  with wp.rcNormalPosition do begin
   left  :=strtol(buf,@sp);
   top   :=strtol(sp+1,@sp);
   right :=strtol(sp+1,@sp);
   bottom:=strtol(sp+1,@sp);
  end;
  SortRect(wp.rcNormalPosition);
  if IsRectEmpty(wp.rcNormalPosition) then exit;
  MoveRectIntoFullScreen(wp.rcNormalPosition);
  wp.showCmd:=SW_Hide;
  if (CmdShow in [SW_ShowNormal,SW_ShowNA,SW_Restore])
  and (lstrcmpi(CmdLine,'/hidden')<>0)	{Hintertr fr Windows 3.x}
  then wp.showCmd:=SW_ShowMinNoActive;
  SetWindowPlacement(MainWnd,@wp);
 end;

procedure SaveConfig;
 var
  i:Integer;
  key:TS7;
  buf:TS255;
 begin
  wvsprintf(buf,'%u',maxline);
  WritePrivateProfileString(stMain,stMaxLine,buf,IniFileName);
  WritePrivateProfileString(stMain,stDefDelim,DefDelim,IniFileName);
  wvsprintf(buf,'%u',d2s_port);
  WritePrivateProfileString(stMain,stPort,buf,IniFileName);
  for i:=0 to HIGH(ranges) do begin
   {$IFDEF Win32}wsprintf1(key,'%d',PChar(i)){$ELSE}wvsprintf(key,'%d',i){$ENDIF};
   if ValidRange(ranges[i]) then begin
    Range2S(ranges[i],buf);
    WritePrivateProfileString(stAcceptList,key,buf,IniFileName);
   end else begin
    WritePrivateProfileString(stAcceptList,key,nil,IniFileName);
   end;
  end;
 end;

procedure SaveWinPos;
 var
  wp:TWindowPlacement;
  buf:TS63;
 begin
  wp.length:=sizeof(wp);
  GetWindowPlacement(MainWnd,@wp);
  wvsprintf(buf,'%d %d %d %d',wp.rcNormalPosition);
  WritePrivateProfileString(stMain,stWinPos,buf,IniFileName);
 end;


procedure vLog(format:PChar; var args);
 var
  key:TS7;
  val:TS255;
 begin
  if format<>nil then begin
   wvsprintf(key,'%03u',LogNum);
   wvsprintf(val,format,args);
   AddError(101,val);
   WritePrivateProfileString(stLog,key,val,IniFileName);
  end else begin
   LogNum:=0;
   WritePrivateProfileString(stLog,nil,nil,IniFileName);
  end;
 end;

function CheckIP(addr:DWord):Boolean;
{Testet gegebene IP-Adresse auf Gltigkeit bzgl. der IP-Bereiche}
 var
  i: Integer;
 begin
  CheckIP:=true;
  addr:=ntohl(addr);
  if addr=$7F000001 then exit;	{localhost 127.0.0.1}
{$IFDEF Win32}
  for i:=0 to HIGH(ranges) do
  if (Cardinal(ranges[i].a)<=Cardinal(addr))
  and (Cardinal(addr)<=Cardinal(ranges[i].e)) then exit;
  CheckIP:=false;
{$ELSE}
  asm	db	$66
	mov	dx,LongRec[addr].lo
	mov	si,offset ranges
	cld
	mov	cx,TYPE ranges / TYPE TIpRange
@@l:	db	$66
	lodsw
	db	$66
	cmp	dx,ax
	db	$66
	lodsw
	jc	@@n
	db	$66
	cmp	ax,dx
	jnc	@@e
@@n:	loop	@@l
	dec	[@Result]	{FALSE nach allen Bereichen}
@@e:
  end;
{$ENDIF}
 end;
(*
procedure AboutBox;
 begin
  vMBox(MainWnd,100{about},MB_IconAsterisk,Statistik);
 end;
*)
{*******************************************
 ** Hilfsroutinen fr Einstellungs-Dialog **
 *******************************************}

procedure LoadAutostartListbox(w:HWnd);
{Autostart-Listbox direkt von INI-Datei laden (keine Speicher-Kopie)
 w=Listbox-Handle}
 const
  TabStop:Integer=40;	{besser automatisch berechnen!}
 var
  sp:PChar;
  buf1,buf2: TS255;
  i: Integer;
 begin
  GetPrivateProfileString(stAutostart,nil,'',buf1,HIGH(buf1)+1,IniFileName);
  sp:=buf1;
  SendMessageP(W,LB_SetTabStops,1,@TabStop);
  repeat
   i:=lstrlen(sp);
   if i=0 then exit;
   lstrcpy(buf2,sp);
   buf2[i]:=#9;
   Inc(i);
   GetPrivateProfileString(stAutostart,sp,'',buf2+i,HIGH(buf2)+1-i,
     IniFileName);
   SendMessageP(W,LB_AddString,0,@buf2);
   Inc(sp,i);
  until false;
 end;

procedure SaveAutostartListbox(w:HWnd);
{w=Listbox-Handle}
 var
  cnt,i: Integer;
  sp2: PChar;
  buf: TS255;
 begin
  cnt:=SendMessage(w,LB_GetCount,0,0);
  WritePrivateProfileString(stAutostart,nil,nil,IniFileName);
  for i:=0 to cnt-1 do begin
   SendMessageP(W,LB_GetText,i,@buf);
   sp2:=lstrchr(buf,#9);
   if sp2=nil then continue;
   sp2^:=#0;	{zerhacken}
   WritePrivateProfileString(stAutostart,buf,sp2+1,IniFileName);
  end;
 end;

function BrowseExecutable:Boolean;
{Ausfhrbares Programm (oder verknpftes Dokument) auswhlen
 SetupDlg=Dialogfenster-Handle}
 var
  ofn:TOpenFileName;
  sp: PChar;
  fname,filter,initdir:TS255;
  title:TS63;
 begin
  BrowseExecutable:=false;
  GetDlgItemText(SetupDlg,111,fname,HIGH(fname)+1);
  LoadString({$IFNDEF Win32}Seg{$ENDIF}(HInstance),111,filter,HIGH(filter)+1);
  LoadString({$IFNDEF Win32}Seg{$ENDIF}(HInstance),112,title,HIGH(title)+1);
  InitStruct(ofn,sizeof(ofn));
  ofn.hwndOwner:=SetupDlg;
  ofn.lpstrFile:=fname;
  UInt(ofn.nMaxFile):=HIGH(fname)+1;
  sp:=GetFileNamePtr(fname);
  if sp<>fname then begin
   lstrcpyn(initdir,fname,sp-fname);
   ofn.lpstrInitialDir:=initdir;
   lstrcpy(fname,sp);
  end;
  ofn.lpstrFilter:=filter;
  ofn.lpstrTitle:=title;
  UInt(ofn.flags):=OFN_FileMustExist or OFN_ShowHelp or OFN_HideReadOnly;
	{hier: erst mal keine langen Dateinamen!}
  if not GetOpenFileName(ofn) then exit;
  SetDlgItemText(SetupDlg,111,fname);
  BrowseExecutable:=true;
 end;

var
 Button3State: Integer;	{0=?, 1=Add, 2=Change, 3=Delete}
procedure SetButton3State(st:Integer);
{Beschriftung des Buttons sowie globale Merkvariable setzen}
 var
  sp:PChar;
  buf:TS63;
 begin
  if Button3State=st then exit;
  Button3State:=st;
  LoadString({$IFNDEF Win32}Seg{$ENDIF}(HInstance),114,buf,HIGH(buf)+1);
  sp:=buf;
  while st<>0 do begin
   Inc(sp,lstrlen(sp)+1);
   Dec(st);
  end;
  SetDlgItemText(SetupDlg,114,sp);
  EnableDlgItem(SetupDlg,114,Bool(Button3State));
 end;

procedure TextChanged;
{Immer wenn sich Text unter "Service" oder "Kommandozeile" ndert,
 muss der vernderliche Button ggf. umbeschriftet werden}
 var
  i: Integer;
  buf:TS63;
 begin
  if (GetDlgItemText(SetupDlg,111,buf,HIGH(buf))=0)
  or (GetDlgItemText(SetupDlg,110,buf,HIGH(buf))=0)
  then SetButton3State(0)
  else begin	{in "buf" ist der Service-Name}
   lstrcat(buf,#9);
   i:=SendDlgItemMsgP(SetupDlg,113,LB_FindString,UInt(-1),@buf);
   SetButton3State(IfThenElse(Bool(i-LB_ERR),2,1));	{auf "ndern"}
   SendDlgItemMessage(SetupDlg,113,LB_SetCurSel,UInt(i),0);
  end;
 end;

procedure ListSelection;
{Immer wenn ein Autostart-Listen-Element ausgewhlt wird,
 werden die Edit-Felder aktualisiert und der Knopf auf "Lschen" gestellt}
 var
  i: Integer;
  sp:PChar;
  buf:TS255;
 begin
  i:=SendDlgItemMessage(SetupDlg,113,LB_GetCurSel,0,0);
  if i<0 then exit;
  SendDlgItemMsgP(SetupDlg,113,LB_GetText,i,@buf);
  sp:=lstrchr(buf,#9);
  if sp=nil then exit;
  sp^:=#0;
  SetDlgItemText(SetupDlg,110,buf);
  SetDlgItemText(SetupDlg,111,sp+1);
  SetButton3State(3);		{auf Lschen}
 end;

procedure HandleButton3State;
{Je nach Beschriftung des Buttons Aktion ausfhren}
 var
  i,j: Integer;
  lb:HWnd;
  buf:TS255;
 begin
  i:=GetDlgItemText(SetupDlg,110,buf,HIGH(buf));
  lstrcpy(buf+i,#9);
  GetDlgItemText(SetupDlg,111,buf+i+1,HIGH(buf)-i);
  lb:=GetDlgItem(SetupDlg,113);
  j:=SendMessage(lb,LB_GetCurSel,0,0);
  if Button3State>=2
  then SendMessage(lb,LB_DeleteString,j,0);
  case Button3State of
   1: SendMessageP(lb,LB_AddString,0,@buf);
   2: SendMessageP(lb,LB_InsertString,j,@buf);
  end;
  SetButton3State(0);	{inaktiv}
 end;

{***********************************************
 ** Einstellungs-Dialog-Prozedur (nichtmodal) **
 ***********************************************}

function SetupDlgProc(Wnd:HWnd; Msg,wParam:UInt; lParam:LongInt):Bool;
{$IFDEF Win32}stdcall{$ELSE}export{$ENDIF};
 label Ende;
 var
  lPar: LongRec absolute lParam;
  CommandID: Word absolute wParam;
  CommandNFY: LongRec absolute {$IFDEF Win32}wParam{$ELSE}lParam{$ENDIF};
  w: HWnd;
  x: UInt;
  i: Integer;
  r: TIpRange;
  s: TS31;
 begin
  SetupDlgProc:=false;
  case Msg of
   WM_InitDialog: begin
    SetupDlg:=Wnd;
    Button3State:=-1;
    SetButton3State(0);
    SetDlgItemInt(Wnd,101,d2s_port,false);
    SetDlgItemInt(Wnd,102,maxline,false);
    w:=GetDlgItem(Wnd,105);
    for i:=0 to HIGH(ranges) do begin
     if ValidRange(ranges[i]) then begin
      Range2s(ranges[i],s);
      SendMessageP(w,LB_AddString,0,@s);
     end;
    end;
    SetDlgItemText(Wnd,107,DefDelim);
    LoadAutostartListbox(GetDlgItem(Wnd,113));
    SetupDlgProc:=true;
   end;
   WM_Activate: KBHand:=IfThenElse(Bool(wParam),Wnd,0);
   WM_Command: case CommandID of
    1,10: begin		{OK, bernehmen}
     x:=GetDlgItemInt(Wnd,102,nil,false);
     if (x<256) or (x>$4000) then begin
      MBox0(Wnd,101,MB_OK);
      SetEditFocus(GetDlgItem(Wnd,101));
      exit;
     end;
     if not SetAcceptPort(GetDlgItemInt(Wnd,101,nil,false)) then begin
      MBox0(Wnd,101,MB_OK);
      SetEditFocus(GetDlgItem(Wnd,101));
      exit;
     end;
     maxline:=x;
     w:=GetDlgItem(Wnd,105);
     for i:=0 to HIGH(ranges) do begin
      if SendMessageP(w,LB_GetText,i,@s)=LB_ERR then break;
      S2Range(ranges[i],s);
     end;
     GetDlgItemText(Wnd,107,DefDelim,HIGH(DefDelim)+1);
     SaveAutostartListbox(GetDlgItem(Wnd,113));
     SaveConfig;
     if CommandID=1 then goto Ende;
    end;
    2: Ende: begin SetupDlg:=0; DestroyWindow(Wnd); end;
    9: WinHelp(Wnd,HelpFileName,HELP_Context,108);
    103: case CommandNFY.hi of		{Eingabezeile}
     EN_Change: EnableDlgItem(Wnd,104,true);
    end;
    104: begin				{Knopf "Hinzufgen"}
     GetDlgItemText(Wnd,103,s,HIGH(s)+1);
     S2Range(r,s);
     if ValidRange(r) then begin
      SendDlgItemMsgP(Wnd,105,LB_AddString,0,@s);
      EnableWindow(HWnd(lParam),false);
     end else begin
      MBox0(Wnd,101,MB_OK);
      SetEditFocus(GetDlgItem(Wnd,103));
     end;
    end;
    105: case CommandNFY.hi of		{Liste}
     LBN_SelChange: begin
      i:=SendMessage(HWnd(lParam),LB_GetCurSel,0,0);
      EnableDlgItem(Wnd,106,i>=0);
      if i>=0 then begin
       SendMessageP(HWnd(lParam),LB_GetText,i,@s);
       SetDlgItemText(Wnd,103,s);	{zum Editieren heranholen}
       EnableDlgItem(Wnd,104,false);
      end;
     end;
    end;
    106: begin				{Knopf "Lschen"}
     w:=GetDlgItem(Wnd,105);
     i:=SendMessage(w,LB_GetCurSel,0,0);
     SendMessage(w,LB_DeleteString,i,0);
     SendMessage(w,LB_SetCurSel,i,0);	{nchste Zeile markieren}
    end;
    110,111: if CommandNFY.hi=EN_Change then TextChanged;
    112: BrowseExecutable;
    113: case CommandNFY.hi of		{Autostart-Liste}
     LBN_SelChange: ListSelection;
    end;
    114: HandleButton3State;
   end;
  end;
 end;

var
 traydata: TNotifyIconData;

procedure ShellNotify;
 begin
  if not Shell_NotifyIcon(NIM_Modify,@traydata) then begin
   traydata.uFlags:=NIF_Icon or NIF_Tip or NIF_Message;
   Shell_NotifyIcon(NIM_Add,@traydata);
  end;
 end;

type
 PPAsync=^PAsync;
 PAsync=^TAsync;
 TAsync=record
  next:PAsync;
  h: LongInt;		{Async-Transaktions-Handle}
  c: Char;      	{Melde-Zeichen fr asynchrone Transaktion}
{  d: Boolean;		{Daten-Flag (fr DdeRequest)}
 end;

 PConvData=^TConvData;
 TConvData=record
  next,prev: PConvData;	{Verkettete Liste, zurzeit NIL wenn DDE-Server}
  sock: TSocket;	{socket for writing notifications}
  conv: HConv;		{DDE conversation, immer lokal!}
  hszService: HSZ;	{DDE service string handle}
  hszTopic: HSZ;	{DDE topic string handle}
  block: UInt;		{blockierte DDE-Transaktionen (in DDEMLs Queue)}
  advises: UInt;	{Aktive ADVISEs in dieser Konversation}
  delim: char;
  ddeserver: Boolean;	{TRUE wenn DDE-Server, FALSE wenn TCP-Server}
  connected: Boolean;	{TRUE wenn "c" von der Gegenseite kam}
  result: hDdeData;
  async: PAsync;	{Verkettete Liste der o.a. Elemente}
 end;

procedure New_Async(var cd:TConvData; ah:LongInt; ac: Char);
{Erzeugt ein neues Async-Verwaltungselement und hngt es in die Liste.}
 var
  async:PAsync;
 begin
  new(async);
  with async^ do begin
   next:=cd.async;
   h:=ah;
   c:=ac;
  end;
  cd.async:=async;
 end;

function Get_Async(var cd:TConvData; ah:LongInt):PAsync;
{Findet und liefert ein Async-Element und hngt es aus der Liste aus.
 Das Element muss mit dispose() freigegeben werden!}
 var
  pre_async:PPAsync;	{Adresse des vorherigen (Next-)Zeigers}
  async:PAsync;		{Betrachtetes Element}
 begin
  pre_async:=@cd.async;
  Get_Async:=nil;
  repeat
   async:=pre_async^;
   if async=nil then exit;
   with async^ do begin
    if h=ah then begin
     pre_async^:=next;	{aus Liste aushngen}
     next:=nil;		{Verfolgung verhindern}
     Get_Async:=async;
     exit;
    end;
    pre_async:=@next;
   end;
  until false;
 end;

procedure AsyncClientTransaction(var cd:TConvData;
  Data: Pointer; DataLen: Integer;
  Item: PChar; DataType: Word; ac:Char);
 var
  Result:DWord;
  ItemHsz:HSZ;
 begin
  if DataLen=-1 then DataLen:=lstrlen(Data)+1;	{ohne oder mit Null?}
  ItemHsz:=0;
  if Item<>nil then ItemHsz:=CreateStringHandle(Item);
{  if Data<>nil then Data:=Pointer(DdeCreateDataHandle(inst,Data,DataLen,
    0,ItemHsz,CF_TEXT,HDATA_AppOwned));}
  if DdeClientTransaction(Data,{-1{}DataLen,cd.conv,ItemHsz,CF_TEXT,
    DataType,TIMEOUT_ASYNC,@Result)<>0 then begin;
   New_Async(cd,Result,ac);
  end;
  FreeStringHandle(ItemHsz);
 end;

function GetCD(Conv:HConv):PConvData;
{Holt ConvData von der Konversation}
 var
  ci: TConvInfo;
 begin
  DdeQueryConvInfo(Conv,QID_Sync,@ci);
  GetCD:=PConvData(ci.hUser);
 end;

function CatStr(s:PChar; space:UInt; sz:HSZ; a:PChar; d:Char):PChar;
{$IFDEF Win32} pascal; {$ENDIF}
{entweder sz oder a ausgeben}
 var
  buf:TS255;
 begin
  if sz<>0 then begin
   DdeQueryString(inst,sz,buf,HIGH(buf)+1,CP_WINANSI);
   a:=buf;
  end;
  CatStr:=s+wvsprintf(s,'%c%s',d);
 end;

procedure Notify(var cd:TConvData; c:Char;s1,s2:PChar);
 var
  ebuf:TS63;
  e:UInt;
  buf,bp:PChar;
 begin
  GetMem(buf,maxline);
  bp:=buf;
  bp^:=c;
  Inc(bp);
  bp:=CatStr(bp,maxline-(bp-buf)-2,cd.hszService,nil,cd.delim);
  bp:=CatStr(bp,maxline-(bp-buf)-2,cd.hszTopic,nil,cd.delim);
  if s1<>nil then bp:=CatStr(bp,maxline-(bp-buf)-2,0,s1,cd.delim);
  if s2<>nil then bp:=CatStr(bp,maxline-(bp-buf)-2,0,s2,cd.delim);
  if c='#' then begin
   e:=DdeGetLastError(inst);
   wvsprintf(ebuf,'Error 0x%X',e);
   bp:=CatStr(bp,maxline-(bp-buf)-2,0,ebuf,cd.delim);
   if (e<DMLERR_First) or (e>DMLERR_Last) then e:=DMLERR_Last+1;
   LoadString({$IFNDEF Win32}Seg{$ENDIF}(HInstance),e,ebuf,HIGH(ebuf)+1);
   bp:=CatStr(bp,maxline-(bp-buf)-2,0,ebuf,cd.delim);
  end;
  lstrcpy(bp,#13#10);
  send(cd.sock,buf^,bp-buf+2,0);
  FreeMem(buf,maxline);
 end;

function GetStatistikPtr(cd:PConvData):PStatistik;
 begin
  GetStatistikPtr:=PStatistik(IfThenElseP(cd^.ddeserver,
    PChar(@Statistik.ddeserv),PChar(@Statistik.tcpserv)));
 end;

procedure IncAdvises(cd:PConvData; um:Integer);
 begin
  Inc(cd^.advises,um);
  IncStatistik(@GetStatistikPtr(cd)^.advises,um);
 end;

procedure HandleDisconnect(cd:PConvData);
 begin
  with cd^ do begin
   prev^.next:=next;
   next^.prev:=prev;
   FreeStringHandle(hszTopic);
   FreeStringHandle(hszService);
   while async<>nil do dispose(Get_Async(cd^,async^.h));
  end;
  IncAdvises(cd,-cd^.advises);
  if cd^.ddeserver then begin
   IncStatistik(@Statistik.ddeserv.clients,-1);
  end else begin
   IncStatistik(@Statistik.tcpserv.servers,-1);
   dispose(cd);
  end;
 end;

type
 TGetOrFind=function(var cd0:TConvData; service,topic:PChar):PConvData;

function iFindConv(var cd0:TConvData; service,topic:PChar):PConvData;
{sucht eine passende Konversation in der Liste}
 var
  hs,ht:HSZ;
  cd: PConvData;
 begin
  iFindConv:=nil;
  cd:=cd0.next;
  if cd=@cd0 then exit;
  hs:=CreateStringHandle(service);
  ht:=CreateStringHandle(topic);
  repeat
   if (DdeCmpStringHandles(cd^.hszService,hs)=0)
   and (DdeCmpStringHandles(cd^.hszTopic,ht)=0) then break;
   cd:=cd^.next;
  until cd=@cd0;
  FreeStringHandle(hs);
  FreeStringHandle(ht);
  if cd=@cd0 then exit;
  iFindConv:=cd;
 end;

function FindConv(var cd0:TConvData; service,topic:PChar):PConvData; far;
{wie oben, aber meckert bei Versagen}
 var
  cd: PConvData;
 begin
  cd:=iFindConv(cd0,service,topic);
  if cd<>nil then begin FindConv:=cd; exit; end;
  cd0.hszService:=CreateStringHandle(service);	{Nur frs Meckern!?!}
  cd0.hszTopic:=CreateStringHandle(topic);
  Notify(cd0,'#',nil,nil);
  FreeStringHandle(cd0.hszService);
  FreeStringHandle(cd0.hszTopic);
  IncStatistik(@Statistik.tcpserv.errors,1);
  FindConv:=nil;
 end;

function GetConv(var cd0:TConvData; service,topic:PChar):PConvData; far;
{Sucht oder erstellt eine Konversation}
 var
  cd:PConvData;
  buf:TS255;
 begin
  GetConv:=nil;
  cd:=iFindConv(cd0,service,topic);
  if cd<>nil then begin GetConv:=cd; exit; end;
  new(cd); Move(cd0,cd^,sizeof(TConvData));
  with cd^ do begin
{   sock:=cd0.sock;}
   hszService:=CreateStringHandle(service);
   hszTopic:=CreateStringHandle(topic);
{   delim:=cd0.delim;}
   conv:=DdeConnect(inst,hszService,hszTopic,nil);
   if conv=0 then begin
    if (GetPrivateProfileString(stAutostart,service,'',
      buf,HIGH(buf)+1,IniFileName)<>0)
    and (ShellExecute(MainWnd,nil,buf,nil,nil,SW_Minimize)>32)
    then conv:=DdeConnect(inst,hszService,hszTopic,nil);	{2. Versuch}
   end;
   if conv=0 then begin
    Notify(cd^,'#',nil,nil);
    IncStatistik(@Statistik.tcpserv.errors,1);
    FreeStringHandle(hszService);
    FreeStringHandle(hszTopic);
    dispose(cd);
    exit;
   end;
   IncStatistik(@Statistik.tcpserv.servers,1);
   DdeSetUserHandle(conv,QID_SYNC,LongInt(cd));
   next:=cd0.next;
   cd0.next:=cd;
   prev:=next^.prev;
   next^.prev:=cd;
  end;
  GetConv:=cd;
 end;

type
 TUrl=record
  prot:PChar;
  user:PChar;
  pass:PChar;
  host:PChar;
  port:PChar;
  rest:PChar;
 end;

procedure ParseURL(s:PChar; var url:TUrl);
{Zerhackt bergebenen String in 6 Teile}
{String-Aufbau: "[prot://][user[:pass]@]host[:port][/rest]"}
 var
  sp:PChar;
 begin
  FillChar(url,sizeof(url),0);
  sp:=lstrchr(s,':');
  if (sp<>nil) and (PWord(sp+1)^=$2F2F) then begin
   sp^:=#0;
   url.prot:=s;
   s:=sp+3;
  end;
  sp:=lstrchr(s,'/');
  if sp<>nil then begin
   sp^:=#0;
   url.rest:=sp+1;
  end;
  sp:=lstrchr(s,'@');
  if sp<>nil then begin
   sp^:=#0;
   url.user:=s;
   s:=lstrchr(s,':');
   if s<>nil then begin
    s^:=#0;
    url.pass:=s+1;
   end;
   s:=sp+1;
  end;
  url.host:=s;
  sp:=lstrchr(s,':');
  if sp<>nil then begin
   sp^:=#0;
   url.port:=sp+1;
  end;
 end;

function TcpConnect(host,port:PChar):TSocket;
{erffnet Socket-Verbindung zu angegebenen Host:Port;
 wenn HIWORD(port)=0 ist, dann ist LOWORD(port) das Port in Host Byte Order}
 label err1,err2;
 var
  so: TSocket;
  sa: TSockAddrIn;
  se: PServEnt;
  he: PHostEnt absolute se;
 begin
  so:=Socket(AF_INET,SOCK_STREAM,IPPROTO_TCP);
  if so=INVALID_SOCKET then goto err1;
  FillChar(sa,sizeof(sa),0);
  sa.sin_family:=AF_INET;
  if LongRec(port).hi=0 then sa.sin_port:=htons(LongRec(port).lo)
  else begin
   se:=PServEnt(GetServByName(port,nil));
   if se=nil then goto err2;
   sa.sin_port:=se^.s_port;
  end;
  sa.sin_addr.s_addr:=inet_addr(host);
  if LongInt(sa.sin_addr)=INADDR_NONE then begin
   he:=PHostEnt(GetHostByName(host));
   if he=nil then goto err2;
   sa.sin_addr.s_addr:=PDWord(he^.h_addr_list^)^;
  end;
  if Connect(so,sa,sizeof(sa))<0 then goto err2;
  TcpConnect:=so;
  exit;
err2:
  CloseSocket(so);
err1:
  TcpConnect:=Invalid_Socket;
 end;

type
 PPSockData=^PSockData;
 PSockData=^TSockData;
 TSockData=record
  next:PSockData;
  cd0: TConvData;
  last:PConvData;	{Zuletzt verwendete Konversation}
  llen:UInt;
  idx: UInt;
  skipchar: Char;
  line:array[0..1] of Char;
 end;

var
 sd0: PSockData;	{Verkettete Liste der Socket-Daten}

function FindSockData(sock:TSocket):PPSockData;
 var
  sdp:PPSockData;
  sd:PSockData;
 begin
  sdp:=@sd0;
  repeat
   sd:=sdp^;
   if sd=nil then break;
   if sd^.cd0.sock=sock then break;
   sdp:=@sd^.next;
  until false;
  FindSockData:=sdp;
 end;

function NewSockData(sock:TSocket; AsServer:Boolean):PSockData;
{erzeugt neues SockData und hngt es in die globale Liste}
 var
  sd: PSockData;
 begin
{$IFDEF Win32}
  sd:=PSockData(GlobalAlloc(GPTR,sizeof(TSockData)-2+maxline));
{$ELSE}
  sd:=Ptr(GlobalAlloc(GPTR,sizeof(TSockData)-2+maxline),0);
{$ENDIF}
  if sd<>nil then with sd^ do begin
   next:=sd0;
   cd0.next:=@cd0;
   cd0.prev:=@cd0;
   cd0.sock:=sock;
   cd0.ddeserver:=AsServer;
   llen:=maxline;
   sd0:=sd;
  end;
  NewSockData:=sd;
 end;

function DdeCallback(CallType,Fmt:UInt; Conv:hConv; HSz1,HSz2:HSz;
  Data:hDdeData; Data1,Data2: DWord): hDdeData;
{$IFDEF WIN32}stdcall{$ELSE}export{$ENDIF};
 label unaccess,block;
 const		{zum Hinberretten nach XTYP_Connect_Confirm}
  ConnectingC:PConvData=nil;
 var
{  EmpfChar: Char;}
{  Sum: Byte;}
{  sp,sp2,sp3: PChar;}
  {i,ec,}ico: Integer;
  cd: PConvData;
  url:TUrl;
  async: PAsync;	{zur Behandlung von XTYP_Xact_Complete}
  sock: TSocket;
  sd: PSockData;
  S{,buf}: array[0..255] of Char;	{1 Byte extra fr Null lassen}
 begin
  DdeCallback:=0;
  ico:=2;			{von Fehlschlag ausgehen}
  cd:=nil;
  if CallType<>XTYP_Connect then begin
   cd:=GetCD(Conv);		{Deskriptor holen}
   if (cd<>nil) and (cd^.block<>0) then begin
    Dec(cd^.block);
    DdeCallback:=cd^.result;	{asynchrones Ergebnis liefern}
    ChangeDdeIcon(ico);		{Erfolg oder Misserfolg anzeigen}
    exit;
   end;
  end;
  case CallType {and XTYP_Mask} of
   XTYP_Connect: begin
    {i:=}DdeQueryString(Inst,Hsz2,s,sizeof(s),CP_WinAnsi);
      {In der Form "ndde://[user[:pass]@]host[:port]/remote_service"}
    ParseURL(s,url);
    if url.prot=nil then exit;
    if lstrcmpi(url.prot,'ndde')<>0 then exit;
    if (url.rest=nil) or (url.rest^=#0) then exit;
    if url.port=nil then url.port:=PChar(d2s_port);
    sock:=TcpConnect(url.host,url.port);
    if sock=INVALID_SOCKET then exit;
    sd:=NewSockData(sock,true);
{    new(cd); FillChar(cd^,sizeof(cd^),0);}
    WSAAsyncSelect(sock,MainWnd,WM_Recv,FD_Read or FD_Close);
    sd^.cd0.hszService:=CreateStringHandle(url.rest);
    DdeKeepStringHandle(inst,hsz1);	{brauchen Kopie}
    sd^.cd0.hszTopic:=hsz1;
    sd^.cd0.delim:=DefDelim[0];
    ConnectingC:=@sd^.cd0;
    Notify(sd^.cd0,'c',nil,nil);
    DdeCallback:=1;	{Verbindung okay melden, obwohl keine Besttigung}
   end;

   XTYP_Connect_Confirm: begin
    cd:=ConnectingC;
    ConnectingC:=nil;
    cd^.conv:=conv;
    DdeSetUserHandle(Conv,QID_Sync,LongInt(cd)); {nachtrgliche Zuordnung!}
    IncStatistik(@Statistik.ddeserv.clients,1);
   end;

   XTYP_Disconnect: begin
    if cd^.ddeserver then begin
     WSAAsyncSelect(cd^.sock,MainWnd,0,0);
     Closesocket(cd^.sock);	{als DDE-Server und TCP-Client, Client tot}
    end else begin
     Notify(cd^,'d',nil,nil);	{als TCP-Server und DDE-Client, Server tot}
     FindSockData(cd^.sock)^^.last:=nil;
    end;
    HandleDisconnect(cd);
   end;

   XTYP_AdvStart: begin					{nur DDE-Server}
    IncAdvises(cd,1);
    Notify(cd^,'a',PChar(hsz2),nil);
    goto block;
   end;

   XTYP_AdvStart or XTYPF_NoData: begin			{nur DDE-Server}
    IncAdvises(cd,1);
    Notify(cd^,'w',PChar(hsz2),nil);
    goto block;
   end;

   XTYP_AdvStop,XTYP_AdvStop or XTYPF_NoData: begin	{nur DDE-Server}
    IncAdvises(cd,-1);
    Notify(cd^,'u',PChar(hsz2),nil);
    exit;
   end;

   XTYP_AdvData: begin					{nur DDE-Client}
    if data<>0 then begin
     Notify(cd^,'m',PChar(hsz2),DdeAccessData(data,nil));
     DdeUnaccessData(data);
    end else begin
     Notify(cd^,'m',PChar(hsz2),nil);
    end;
    DdeCallback:=DDE_fAck;
   end;

   XTYP_Request: begin					{nur DDE-Server}
    IncStatistik(@Statistik.ddeserv.requests,1);
    if Fmt<>CF_Text then exit;	{Kann nicht anders!}
    Notify(cd^,'r',PChar(hsz2),nil);
    goto block;
   end;

   XTYP_AdvReq: begin					{nur DDE-Server}
   {hm, hier brauchen wir wohl eine Liste der Advises??}
    DdeCallback:=cd^.result;	{bereitgestelltes Handle abliefern}
    cd^.result:=0;
   end;

   XTYP_Execute: begin
    IncStatistik(@Statistik.ddeserv.execs,1);
    Notify(cd^,'e',nil,DdeAccessData(Data,nil));
    goto unaccess;
   end;

   XTYP_Poke: begin					{nur DDE-Server}
    IncStatistik(@Statistik.ddeserv.pokes,1);
    if Fmt<>CF_Text then exit;		{Kann nicht anders!}
    Notify(cd^,'p',PChar(hsz2),DdeAccessData(Data,nil));
unaccess:
    DdeUnaccessData(Data);
block:
    DdeCallback:=CBR_Block;
    Inc(cd^.block);
    exit;
   end;

   XTYP_Xact_Complete: begin				{nur DDE-Client}
    async:=Get_Async(cd^,data1);
    if async=nil then begin
     vLog('XTYP_XACT_COMPLETE: Kann Handle %#lX nicht finden!',data1);
     exit;
    end;
    if data<>0 then begin		{wenn Transaktion OK}
     case async^.c of
      'a','w': IncAdvises(cd,1);
      'u': IncAdvises(cd,-1);
     end;
     if async^.c='r' then begin		{mit Daten (Request)}
      Notify(cd^,async^.c,PChar(hsz2),DdeAccessData(data,nil));
      DdeUnaccessData(data);
     end else begin			{ohne Daten (alles andere)}
      Notify(cd^,async^.c,PChar(hsz2),nil);
     end;
     ChangeDdeIcon(3);
    end else begin
     Notify(cd^,'#',PChar(hsz2),nil);	{Fehlermeldung}
     IncStatistik(@Statistik.tcpserv.errors,1);
     ChangeDdeIcon(2);
    end;
    dispose(async);
   end;

  end;
 end;

procedure HandleAccept;
 var
  cli: TSocket;
  addrlen: Integer;
  sa: TSockAddrIn;
  sp: PChar;
{  sd: PSockData;}
 begin
  addrlen:=sizeof(sa);
  cli:=accept(AcceptSock,WinSock.PSockAddr(@sa)^,addrlen);
  sp:=inet_ntoa(sa.sin_addr{$IFNDEF Win32}.s_addr{$ENDIF});
  if CheckIP(sa.sin_addr.s_addr) then begin
   if NewSockData(cli,false)=nil then begin
    vLog('No memory in HandleAccept() from %s',sp);
    closesocket(cli);
    exit;
   end;
   WSAAsyncSelect(cli,MainWnd,WM_Recv,FD_Read or FD_Close);
{   vLog('Connect from %s accepted',sp);}
   IncStatistik(@Statistik.tcpserv.clients,1);
  end else begin
   closesocket(cli);
   vLog('Connect from %s rejected',sp);
  end;
 end;

procedure EnableCallback(var cd:TConvData);
 begin
  DdeEnableCallback(Inst,cd.conv,
    IfThenElse(Bool(cd.block-1),EC_EnableOne,EC_EnableAll));
 end;

procedure HandleLine(var sd:TSockData);
 label gem;
 var
  argv: PArgv;
  argc: Integer;
  cd: PConvData;
  i: Integer;
  xtyp: Word;
  hItem: HSZ;
{  r: HDdeData;}
  hexbuf: array[0..11] of Char;

 procedure Args(GetOrFind:TGetOrFind; MinArgC:Integer);
  begin
   if argc<MinArgC then begin
    cd:=sd.last;
    i:=1;	{nchstes Argument ist hier}
   end else begin
    cd:=GetOrFind(sd.cd0,argv^[1],argv^[2]);
    i:=3;	{nchstes Argument ist dort}
   end;
   if cd<>nil then sd.last:=cd;		{Eintragung}
  end;

 begin
  with sd do begin
   if idx=0 then exit;	{Leerzeilen stillschweigend durchfallen lassen}
   if idx>1 then begin
    cd0.delim:=line[1];
    argv:=split(line,line[1],@argc);
   end else argc:=1;
   if cd0.ddeserver then case line[0] of
    'c': begin
     cd0.connected:=true;
    end;
    'a','w','e','p': begin
     cd0.result:=DDE_FAck;
     EnableCallback(cd0);
    end;
    '#': begin
     IncStatistik(@Statistik.ddeserv.errors,1);
     cd0.result:=DDE_FNotProcessed;
     if cd0.connected then EnableCallback(cd0)
     else begin
      DdeDisconnect(cd0.conv);
      HandleDisconnect(@cd0);
     end;
    end;
    'm','r': begin
     hItem:=CreateStringHandle(argv^[3]);
     if argv^[4]<>nil then cd0.result:=DdeCreateDataHandle(
       inst,argv^[4],lstrlen(argv^[3])+1,0,hItem,CF_Text,0)
     else cd0.result:=0;
     if line[0]='r' then EnableCallback(cd0)
     else DdePostAdvise(inst,cd0.hszTopic,hItem);
     {Hier fehlt noch das Retten der Daten hinber zu XTYP_AdvReq}
     FreeStringHandle(hItem);
    end;
    'd': begin
     HandleDisconnect(@cd0);
    end;

   end else case line[0] of	{DDE-Kunde}

    'c': begin
     Args(GetConv,3);
     if cd<>nil then begin
      wvsprintf(hexbuf,'0x%08X',cd^.conv);
      Notify(cd^,'c',hexbuf,nil);
     end;
    end;

    'a': begin
     Args(GetConv,4);
     xtyp:=XTYP_ADVSTART;
     goto gem;
    end;

    'w': begin
     Args(GetConv,4);
     xtyp:=XTYP_ADVSTART or XTYPF_NODATA;
     goto gem;
    end;

    'u': begin
     Args(FindConv,4);
     xtyp:=XTYP_ADVSTOP;
     goto gem;
    end;

    'e': begin
     IncStatistik(@Statistik.tcpserv.execs,1);
     Args(GetConv,4);
     if cd<>nil then while i<argc do begin
      AsyncClientTransaction(cd^,argv^[i],-1,nil,XTYP_EXECUTE,line[0]);
      Inc(i);
     end;
    end;

    'p': begin
     IncStatistik(@Statistik.tcpserv.pokes,1);
     Args(GetConv,5);
     if cd<>nil then while i<argc-1 do begin
      AsyncClientTransaction(cd^,argv^[i+1],-1,argv^[i],XTYP_POKE,line[0]);
      Inc(i,2);
     end;
    end;

    'r': begin
     IncStatistik(@Statistik.tcpserv.requests,1);
     Args(GetConv,4);
     xtyp:=XTYP_REQUEST;
gem: if cd<>nil then while i<argc do begin
      AsyncClientTransaction(cd^,nil,0,argv^[i],xtyp,line[0]);
      Inc(i);
     end;
    end;

    'd': begin
     Args(FindConv,3);
     if cd<>nil then begin
      DdeDisconnect(cd^.conv);
      HandleDisconnect(cd);
      last:=nil;
     end;
    end;
   end{case};

   LocalFree(UInt(argv));
   idx:=0;
  end;
 end;

procedure HandleRecv(sock:TSocket);
 label backstep,endline,default;
 var
  sd: PSockData;
  c: Char;
 begin
  sd:=FindSockData(sock)^;
  if sd=nil then exit;
  with sd^ do repeat
   if recv(sock,c,1,0)<>1
   then exit;	{einzelzeichenweise...}
   if c<>skipchar then begin
    case c of
     #0: ;	{kann nicht behandeln, ignorieren}
     #127:goto backstep;
     #8:  backstep: if (idx<>0) then Dec(idx);
     #10: begin skipchar:=#13; goto endline; end;
     #13: begin skipchar:=#10; endline:
      line[idx]:=#0; HandleLine(sd^);
     end;
     ^U: idx:=0;		{Zeile lschen}
     #9: begin c:=' '; goto default; end;
     else default: line[idx]:=c; Inc(idx);
    end;
   end;
   skipchar:=#0;
   if idx=llen then Dec(idx);	{Zeichen abschneiden und auf \n warten}
  until false;
 end;

procedure HandleClose(sock:TSocket);
 var
  sdp:PPSockData;
  sd: PSockData;
{  cd: PConvData;}
 begin
  sdp:=FindSockData(sock);
  sd:=sdp^;
  if sd=nil then exit;
  with sd^ do begin
{alle DDETERM durchgehen!}
   while cd0.next<>@cd0 do begin
    DdeDisconnect(cd0.next^.conv);
    HandleDisconnect(cd0.next);
   end;
   sdp^:=next;
  end;

  if sd^.cd0.ddeserver
  then IncStatistik(@Statistik.ddeserv.servers,-1)
  else IncStatistik(@Statistik.tcpserv.clients,-1);
  GlobalFree({$IFDEF Win32}Integer(sd){$ELSE}PtrRec(sd).sel{$ENDIF});
  CloseSocket(sock);
 end;

procedure StartTelnet;
 var
  s: TS255;
  r: THandle;
 begin
  wvsprintf(s,'telnet 127.0.0.1 %d',d2s_port);
  if MBox1(MainWnd,106,MB_OKCancel,s)<>IDOK then exit;
  r:=WinExec(s,SW_Show);
  if r<=32 then MBox1(MainWnd,107,MB_OK,PChar(r));
 end;

function CloseDlgProc(Wnd:HWnd; Msg,wParam:UInt; lParam:LongInt):Bool;
{$IFDEF Win32}stdcall{$ELSE}export{$ENDIF};
 label Ende;
 begin
  CloseDlgProc:=false;
  case Msg of
   WM_InitDialog: begin
    if IsIconic(MainWnd) then begin
     ShowDlgItem(Wnd,1,SW_Hide);
    end;
    CloseDlgProc:=true;
   end;
   WM_Command: case Word(wParam) of
    1: begin ShowWindow(MainWnd,SW_Minimize); goto Ende; end;
    2: Ende: EndDialog(Wnd,IDCancel);
    3: EndDialog(Wnd,IDOK);
    4: begin ShowWindow(MainWnd,SW_Hide); goto Ende; end;
    9: WinHelp(Wnd,HelpFileName,HELP_Context,109);
   end;
  end;
 end;

procedure ZeroStatistik;
 var
  e: EStatistik;
  p: PUInt;
 begin
  for e:=LOW(e) to HIGH(e) do
  if e in [E_REQUEST,E_POKE,E_EXEC,E_ERROR] then begin
   p:=@Statistik.ddeserv.all[e];
   IncStatistik(p,-p^);
  end;
 end;

var
 MinSize: TPoint;	{Ausgangsgre fr Dialogfenster}

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;
 end;

function MainDlgProc(Wnd:HWnd; Msg,wParam:UInt; lParam:LongInt):Bool;
{$IFDEF Win32}stdcall{$ELSE}export{$ENDIF};
 label notray;
 var
  lPar: LongRec absolute lParam;
  lParCmd: LongRec absolute {$IFDEF Win32}wParam{$ELSE}lParam{$ENDIF};
  P: TPoint;
  R: TRect;
  m,sysm: HMenu;
  i,j: Integer;
  s: TS63;
  wd: TWsaData;
 begin
  MainDlgProc:=false;
  case Msg of
   WM_InitDialog: begin
    MainWnd:=Wnd;
    Listbox:=GetDlgItem(Wnd,110);
    sysm:=GetSystemMenu(Wnd,false);
    DeleteMenu(sysm,SC_Maximize,0);
    m:=LoadMenu({$IFNDEF Win32}Seg{$ENDIF}(HInstance),MakeIntResource(100));	{Tray-Men}
    for i:=0 to 3 do begin
     j:=i shl 4 + $1B0;
     GetMenuString(m,j,s,HIGH(s)+1,MF_ByCommand);
     InsertMenu(sysm,i,MF_ByPosition or MF_String,j,s);
	{Einstellungen... - Hilfe - Verschwinde!}
    end;
    DestroyMenu(m);
    PostMessage(Wnd,WM_ContinueInit,0,0);
    if Swap(Word(GetVersion))>=3*256+95 then begin
     LoadString({$IFNDEF Win32}Seg{$ENDIF}(HInstance),110,s,sizeof(s));	{In den Tray!}
     InsertMenu(sysm,4,MF_ByPosition or MF_String,$1F0,s);
     if CmdShow in [SW_Minimize,SW_ShowMinimized,SW_ShowMinNoActive]
     then PostMessage(Wnd,WM_SysCommand,$1F0,0);
    end;
    LoadString({$IFNDEF Win32}Seg{$ENDIF}(HInstance),105,s,sizeof(s));
    PChar(lParam):=s;
    Wnd:=GetDlgItem(Wnd,101);
    for i:=0 to 2 do begin
     SendMessage(Wnd,CB_AddString,0,lParam);
     Inc(lParam,lstrlen(PChar(lParam))+1);
    end;
    SendMessage(Wnd,CB_SetCurSel,0,0);
    GetMinSize;		{... und KEIN Fokus setzen!}
    LoadWinPos;
   end;
   WM_ContinueInit: begin
    i:=WSAStartup($101,wd);
    if i<>0 then SockError(i);
    LoadConfig;
    vLog(nil,{$IFDEF Win32}HInstance{$ELSE}Mem[0:0]{$ENDIF});
    DdeNameService(inst,0,0,DNS_FilterOff);
   end;
   WM_Activate: KBHand:=IfThenElse(Bool(wParam),Wnd,0);
   WM_GetMinMaxInfo: begin
    PMinMaxInfo(lParam)^.ptMinTrackSize:=MinSize;
   end;
   WM_Size: if wParam=SIZE_Minimized then begin
    Auswahl:=-1;
    if traydata.cbSize<>0 then ShowWindow(Wnd,SW_Hide);
   end else begin
    GetWindowRect(Listbox,R); ScreenToClient(Wnd,PPoint(@R)^);
    SetWindowPos(Listbox,0,0,0,
      lPar.lo-8-R.left,lPar.hi-8-R.top,SWP_NoZOrder or SWP_NoMove);
    {$IFDEF Win32}
    SendMessage(Wnd,WM_Command,CBN_SelChange*$10000+101,GetDlgItem(Wnd,101));
    {$ELSE}
    SendMessageWW(Wnd,WM_Command,101,CBN_SelChange,GetDlgItem(Wnd,101));
    {$ENDIF}
   end;
   WM_Timer: begin
    KillTimer(Wnd,102);
    if CurIcon<>0 then ChangeDdeIcon(1);
   end;
   WM_IconChange: begin
    HIcon(lParam):=Icons[wParam];
    SetClassUInt(Wnd,GCL_HIcon,HIcon(lParam));
    InvalidateRect(Wnd,nil,true);
    if traydata.cbSize<>0 then begin
     traydata.hIcon:=HIcon(lParam);
     traydata.uFlags:=NIF_Icon;		{nur Icon ndern}
     ShellNotify;
    end;
   end;
   WM_SetText: if traydata.cbSize<>0 then begin
    lstrcpy(traydata.szTip,PChar(lParam));
    traydata.uFlags:=NIF_Tip;		{nur Text ndern}
    ShellNotify;
   end;
   WM_SysCommand: case wParam and $FFF0 of
    $1A0..$1DF: SendMessage(Wnd,WM_Command,wParam and $FFF0,0);
    $1E0: ShowWindow(Wnd,SW_Hide);
    $1F0: begin
     InitStruct(traydata,sizeof(traydata));
     traydata.wnd:=Wnd;
     traydata.uID:=110;
     traydata.uFlags:=NIF_Icon or NIF_Tip or NIF_Message;
     traydata.uCallbackMessage:=WM_Tray;
     traydata.hIcon:=GetClassUInt(Wnd,GCL_HIcon);
     GetWindowText(Wnd,traydata.szTip,HIGH(traydata.szTip)+1);
     if Shell_NotifyIcon(NIM_Add,@traydata)
     then ShowWindow(Wnd,SW_Hide)
     else MBox0(Wnd,104,MB_OK);		{"Widriges OS"}
    end;
   end;
   WM_Tray: case UInt(lParam) of
    WM_LButtonDown: begin
     ShowWindow(Wnd,SW_Restore);
    end;
    WM_RButtonDown: begin
     m:=LoadMenu({$IFNDEF Win32}Seg{$ENDIF}(HInstance),MakeIntResource(100));
     sysm:=GetSubMenu(m,0);
     GetCursorPos(P);
     TrackPopupMenu(sysm,TPM_RightAlign or TPM_RightButton,
      P.x,P.y,0,Wnd,nil); {BUG: Win98: 16bit: Men in diesem Fall nach links}
     DestroyMenu(m);
    end;
   end;
   WM_Accept: HandleAccept;
   WM_Recv: begin
    if lPar.lo and FD_Read <>0 then HandleRecv(wParam);
    if lPar.lo and FD_Close<>0 then HandleClose(wParam);
    {Es muss auch noch FD_Write beackert werden, sonst kann
     ein blockierendes send() den ganzen D2S-Umsetzer aufhalten!!}
   end;
   WM_Command: case Word(wParam) of
    2: ShowWindow(Wnd,SW_Minimize);	{besser als gar nichts}
    3: SendMessage(Wnd,WM_Close,0,0);	{vom System-Tray}
    $1A0: ShowWindow(Wnd,SW_ShowNormal);
    $1B0: if SetupDlg<>0 then SetActiveWindow(SetupDlg)
    else CreateDialog({$IFNDEF Win32}Seg{$ENDIF}(HInstance),MakeIntResource(108),0,@SetupDlgProc);
    $1C0: StartTelnet;
    $1D0: WinHelp(Wnd,HelpFileName,HELP_Index,0);
    $1E0: goto notray;		{Verschwinde!}
    $1F0: begin			{Normales Fenster!}
     if not IsWindowVisible(Wnd) then ShowWindow(Wnd,SW_Minimize);
notray:
     Shell_NotifyIcon(NIM_Delete,@traydata);
     traydata.cbSize:=0;	{auch knftig deaktivieren}
    end;
    101: case lParCmd.hi of	{Combobox}
     CBN_SelChange: begin
      Auswahl:=SendMessage(HWnd(lParam),CB_GetCurSel,0,0);
      IncStatistik(nil,0);	{Komplett neu zeichnen}
     end;
    end;
    111: begin			{Lschen}
     SendMessage(Listbox,LB_ResetContent,0,0);
     ZeroStatistik;
    end;
   end;
   WM_Close: begin
    if DialogBox({$IFNDEF Win32}Seg{$ENDIF}(HInstance),MakeIntResource(109),
      Wnd,@CloseDlgProc)<>IDOK then exit;
    i:=Statistik.ddeserv.clients+Statistik.tcpserv.clients;
    if (i<>0)
    and (MBox1(Wnd,109{WarnClose},MB_IconQuestion or MB_YesNo or MB_Sound,
      PChar(i))<>IDYes)
    then exit;
    if traydata.cbSize<>0 then Shell_NotifyIcon(NIM_Delete,@traydata);
    WinHelp(Wnd,HelpFileName,HELP_Quit,0);
    SaveWinPos;
    WSACleanup;
    DestroyWindow(Wnd);
   end;
   WM_Destroy: PostQuitMessage(0);
  end;
 end;

const
 wc: TWndClass=(
  style: CS_DblClks;
  lpfnWndProc: @DefDlgProc;
  cbClsExtra: 0;
  cbWndExtra: DlgWindowExtra;
  hInstance: {$IFDEF Win32}0{$ELSE}Seg(HInstance){$ENDIF};
  hIcon: 0;
  hCursor: 0;
  hbrBackground: COLOR_Background+1;
  lpszMenuName: nil;
  lpszClassName: AppName);
var
 Msg:TMsg;
 i: Integer;
{$IFDEF Win32}
 si:TStartupInfo;
{$ENDIF}
begin
{$IFDEF Win32}
 MainWnd:=FindWindow(AppName,nil);
 if (MainWnd<>0) then begin
  ShowWindow(MainWnd,SW_ShowMinimized);
  SetActiveWindow(MainWnd);
  exit;
 end;
 wc.hInstance:=HInstance;
 GetStartupInfo(si);
 CmdShow:=si.wShowWindow;
{$ELSE}
 if HPrevInst<>0 then begin
  ShowWindow(MemW[HPrevInst:Ofs(MainWnd)],SW_ShowMinimized);
  SetActiveWindow(MemW[HPrevInst:Ofs(MainWnd)]);
  exit;
 end;
{$ENDIF}
 GetModuleFileName({$IFDEF Win32}0{$ELSE}Seg(HInstance){$ENDIF},
   IniFileName,HIGH(IniFileName)+1);
 lstrcpy(GetFileNamePtr(IniFileName),'d2s.ini');
 for i:=0 to HIGH(Icons) do Icons[i]:=LoadIcon(
   {$IFNDEF Win32}Seg{$ENDIF}(HInstance),MakeIntResource(100+i));
 wc.hIcon:=Icons[0];
 wc.hCursor:=LoadCursor(0,IDC_Arrow);
 RegisterClass(wc);
 CreateDialog({$IFNDEF Win32}Seg{$ENDIF}(HInstance),
   MakeIntResource(100),0,@MainDlgProc);
 GetWindowText(MainWnd,AppTitle,HIGH(AppTitle)+1);
 StdMBoxTitle:=AppTitle;
 if DdeInitialize(
   Inst,
   DdeCallBack,
   CBF_Skip_Registrations or CBF_Skip_Unregistrations,
   0)<>DMLErr_No_Error
 then DdeError(DMLErr_Sys_Error);
 while GetMessage(Msg,0,0,0) do begin
  if (KBHand<>0) and IsDialogMessage(KBHand,Msg) then continue;
  TranslateMessage(Msg);
  DispatchMessage(Msg);
 end;
 DdeUninitialize(Inst);
 for i:=0 to HIGH(Icons) do DestroyIcon(Icons[i]);
end.
Vorgefundene Kodierung: UTF-80