{$A+,B-,D+,F-,G+,I-,K+,L+,N-,P-,Q-,R-,S-,T-,V+,W-,X+,Y+}
{$M $3000,8192}
program finger;
uses winsock, strings, winprocs, wintypes, WinDos, Win31, MMSystem;
{$R finger}
{$D Windows Mail Checker V1.1 (12/96)}
type
LongRec=record
Lo,Hi: Word;
end;
function ULongMul(A,B:Word):LongInt;
inline($5A/$58/$F7/$E2); {pop dx; pop ax; mul dx}
const
myVerReqd : word=$101;
var
myWSAData : TWSADATA;
procedure CleanUp;
begin
if WSACleanup <> 0 then exit;
end;
const
MainWndClass: array[0..7] of Char='Finger1';
HuhuWndClass: array[0..4] of Char='HUHU';
var
Remote_Host_Buffer: array[0..MaxGetHostStruct-1] of Char;
Remote_Host: THostEnt absolute Remote_Host_Buffer;
Remote_Addr: TsockaddrIn;
FingerSocket: TSocket;
FingerPort: Word;
SP:PChar;
Puffer: array[0..4095]of Char;
Puffergroesse: Word;
FingerAllowed: Boolean; {=False}
function CreateSocket:boolean;
begin
FingerSocket:=Socket(PF_INET, SOCK_STREAM, IPPROTO_IP);
CreateSocket:=FingerSocket<>INVALID_SOCKET;
end;
function ConnectSocket:boolean;
begin
ConnectSocket:=false;
if not FingerAllowed then exit;
FingerPort:=79; {anstelle von GetServByName}
FillChar(Remote_Addr,sizeof(Remote_Addr),0);
Remote_addr.sin_family:=PF_INET;
Remote_addr.sin_port:=htons(FingerPort);
Remote_addr.sin_addr.s_addr:=PDWord(Remote_Host.h_addr_list^)^;
{ MessageBox(0,Inet_ntoa(LongInt(Pointer(@Remote_addr.sin_addr)^)),nil,0);}
if Connect(FingerSocket,Remote_Addr,SizeOf(Remote_Addr))=0
then exit;
SP:=Puffer; {Zeiger auf Pufferanfang}
Puffergroesse:=sizeof(Puffer);
ConnectSocket:=true;
end;
function DestroySocket:boolean;
begin
DestroySocket:=CloseSocket(FingerSocket)=0;
end;
function SendUser(User: PChar):boolean;
{User-Name als ganzes senden}
var
rc: Integer;
S: array[0..255]of Char;
begin
SendUser:=false;
rc:=wvsprintf(S,'%s'#13#10,User); {Username, gefolgt von 0D0Ah}
SP:=Puffer; {Zeiger auf Pufferanfang}
Puffergroesse:=sizeof(Puffer);
if Send(FingerSocket,S,rc,0)<>rc then exit;
SendUser:=true;
end;
function ReceiveStringpiece:boolean;
{diese liefert ausnahmsweise FALSE auch bei Stringende (?)}
var
rc: Integer;
begin
ReceiveStringPiece:=false;
rc:=Recv(FingerSocket,SP^,Puffergroesse-1,0);
if rc=SOCKET_ERROR then exit;
Dec(Puffergroesse,rc); {Rest-Bytes im Puffer neuberechnen}
Inc(SP,rc); {Lesezeiger vorrücken}
SP^:=#0; {String terminieren}
if rc=0 then exit; {bis kein Byte mehr kommt}
ReceiveStringPiece:=true;
end;
function MyStrPos(Str,SubStr:PChar;Flags:Word):PChar;
var
SP1,SP2:PChar;
begin
MyStrPos:=nil;
if Flags and 1 =0 then begin {case-insensitiv}
SP1:=StrNew(Str); if SP1=nil then exit; StrUpper(SP1);
SP2:=StrNew(SubStr); if sp2=nil then exit; StrUpper(SP2);
{Strings kopieren und großmachen}
MyStrPos:=StrPos(SP1,SP2);
StrDispose(SP1);
StrDispose(SP2);
end else begin {case-sensitiv}
if (Str=nil) or (SubStr=nil) then exit;
MyStrPos:=StrPos(Str,SubStr);
end;
end;
function AboutProc(Window:HWnd; Message,wParam:Word; lParam:LongInt):Bool; export;
begin
AboutProc:=false;
case Message of
WM_Command: case wParam of
ID_OK: EndDialog(Window,ID_OK);
ID_Cancel: EndDialog(Window,ID_Cancel);
end;
end;
end;
const
hShowString: HWnd=0; {Show-String-Editfenster}
function ShowStringProc(Window:HWnd; Message,wParam:Word; lParam:LongInt):LongInt; export;
const
hEdit:HWnd=0;
var
CreatePtr: PCreateStruct absolute lParam;
S: array[byte]of Char;
begin
ShowStringProc:=0;
case Message of
WM_Create: begin
hEdit:=CreateWindow('EDIT','',
WS_Child or WS_VScroll or WS_Visible
or ES_AutoVScroll or ES_ReadOnly or ES_MultiLine,
0,0,CreatePtr^.cx,CreatePtr^.cy,
Window,0,hInstance,nil);
SendMessage(hEdit,WM_SetFont,GetStockObject(ANSI_Fixed_Font),0);
end;
WM_Size: begin
SetWindowPos(hEdit,0,0,0,LongRec(lParam).Lo,LongRec(lParam).Hi,SWP_NoZOrder);
end;
WM_User+30: begin
SetWindowText(hEdit,PChar(lParam));
SendMessage(hEdit,EM_SetReadOnly,1,0);
{Man muß es dem Editor offenbar jedesmal neu sagen...}
end;
WM_Destroy: hShowString:=0;
else ShowStringProc:=DefWindowProc(Window,Message,wParam,lParam);
end;
end;
const
IniName:array[0..10]of Char='FINGER.INI'#0;
HelpFile: array[0..10]of Char='FINGER.HLP'#0;
{Globale Variablen des Programms, einstellbar im Konfigurations-Dialog}
{type
TTransferRec=record
sect,user,host,matchpat,execname: array[0..31]of Char;
delay,matchflags,execcmd: Word;
end;}
var
Sektion: array[0..31]of Char; {Bezeichner der Konfiguration}
Username: array[0..31]of Char;
Servername: array[0..31]of Char;
Delay: Word; {hier: in Sekunden}
SearchString: array[0..31]of Char;
SRFlags: Word;
ExecName: array[byte]of Char;
ExecCmd: Word;
procedure LoadSettings(Section:PChar);
begin
GetPrivateProfileString(Section,'User','[user]',Username,sizeof(Username),IniName);
GetPrivateProfileString(Section,'Host','[host]',Servername,sizeof(Servername),IniName);
Delay:=GetPrivateProfileInt(Section,'Delay',15,IniName);
GetPrivateProfileString(Section,'Match','New Mail',SearchString,sizeof(SearchString),IniName);
SRFlags:=GetPrivateProfileInt(Section,'MatchFlags',0,IniName);
GetPrivateProfileString(Section,'Command','',ExecName,sizeof(ExecName),IniName);
if GetPrivateProfileInt(Section,'AsIcon',0,IniName)=0
then ExecCmd:=SW_ShowNormal
else ExecCmd:=SW_Minimize;
end;
function WritePrivateProfileStringEvtl(Section,Key,Value,DefVal,IniName:PChar):Bool;
begin
if lStrCmpi(Value,DefVal)=0 then
WritePrivateProfileStringEvtl:=
WritePrivateProfileString(Section,Key,nil,IniName)
else
WritePrivateProfileStringEvtl:=
WritePrivateProfileString(Section,Key,Value,IniName);
end;
procedure SaveSettings(Section:PChar);
var
S: array[0..7] of Char;
W: Word;
begin
WritePrivateProfileString(Section,'User',Username,IniName);
WritePrivateProfileString(Section,'Host',Servername,IniName);
WritePrivateProfileStringEvtl(Section,'Match',SearchString,'New Mail',IniName);
wvsprintf(S,'%d',SRFlags);
WritePrivateProfileStringEvtl(Section,'MatchFlags',S,'0',IniName);
wvsprintf(S,'%d',Delay);
WritePrivateProfileStringEvtl(Section,'Delay',S,'15',IniName);
WritePrivateProfileStringEvtl(Section,'Command',ExecName,'',IniName);
W:=Word(Bool(ExecCmd<>SW_ShowNormal)); wvsprintf(S,'%d',W);
WritePrivateProfileStringEvtl(Section,'AsIcon',S,'0',IniName);
end;
var
Wnd: HWnd; {Globale Variable Hauptfenster ist besser im Zugriff!}
function KonfProc(Window:HWnd; Message,wParam:Word; lParam:LongInt):Bool; export;
var
f: Text; {jawohl: INI-Datei muß von Hand beackert werden!}
Line: array[byte]of Char;
SP1,SP2: PChar;
Nummer: Word;
const
WM_SetEdits=WM_User+101;
Anzahl: Word=0;
begin
KonfProc:=false;
case Message of
WM_InitDialog: begin
Nummer:=GetWindowsDirectory(Line,sizeof(Line));
if Line[Nummer-1]<>'\' then begin
Line[Nummer]:='\'; Line[Nummer+1]:=#0;
end;
lStrCat(Line,IniName);
Assign(f,Line); {$I-}Reset(f);{ $I+}
Anzahl:=0;
if IOResult=0 then begin
while not eof(f) do begin
ReadLn(f,Line);
SP1:=StrScan(Line,'[');
if SP1<>nil then begin
Inc(SP1); {Startpunkt festlegen}
SP2:=StrScan(SP1,']');
if SP2<>nil then begin
SP2^:=#0; {String terminieren}
SendDlgItemMessage(Window,101,CB_AddString,0,LongInt(SP1));
if lStrCmpi(SP1,Sektion)=0 then begin
SendDlgItemMessage(Window,101,CB_SetCurSel,Anzahl,0);
end;
Inc(Anzahl);
end{if};
end{if};
end{while};
Close(f);
end{if};
SendMessage(Window,WM_SetEdits,0,LongInt(@Sektion)); {SetEdit}
KonfProc:=true;
end;
WM_SetEdits: begin {SetEdit's, lParam=Sektions-Name}
SetDlgItemText(Window,102,UserName);
SetDlgItemText(Window,103,ServerName);
SetDlgItemInt(Window,104,Delay,false);
SetDlgItemText(Window,105,SearchString);
CheckDlgButton(Window,108,SRFlags);
SetDlgItemText(Window,106,ExecName);
CheckDlgButton(Window,109,Word(Bool(ExecCmd<>SW_ShowNormal)));
EnableWindow(GetDlgItem(Window,107),lStrCmpi(PChar(lParam),'Finger Default')<>0);
end;
WM_Command: case wParam of
101: case LongRec(lParam).Hi of
CBN_SelChange: begin {Neue Selektion: Strings neu setzen}
Nummer:=SendDlgItemMessage(Window,101,CB_GetCurSel,0,0);
SendDlgItemMessage(Window,101,CB_GetLBText,Nummer,LongInt(@Line));
LoadSettings(Line); {Ini-Teil laden}
SendMessage(Window,WM_SetEdits,0,LongInt(@Line)); {Alle Felder neu setzen}
end;
end;
ID_OK: begin {OK-Taste: Abspeichern}
Delay:=GetDlgItemInt(Window,104,nil,false);
if Delay=0 then begin
SetFocus(GetDlgItem(Window,104));
exit;
end;
GetDlgItemText(Window,101,Sektion,sizeof(Sektion));
GetDlgItemText(Window,102,UserName,sizeof(UserName));
GetDlgItemText(Window,103,ServerName,sizeof(ServerName));
GetDlgItemText(Window,105,SearchString,sizeof(SearchString));
SRFlags:=IsDlgButtonChecked(Window,108);
GetDlgItemText(Window,106,ExecName,sizeof(ExecName));
if IsDlgButtonChecked(Window,109)<>1 then
ExecCmd:=SW_ShowNormal
else ExecCmd:=SW_Minimize; {wenn markiert}
if lStrLen(Sektion)>0 then {und nur benamstes speichern!}
SaveSettings(Sektion); {Ini-Sektion speichern}
EndDialog(Window,ID_OK);
end;
ID_Cancel: begin
LoadSettings(Sektion); {Ini laden ??? (unsauber)}
EndDialog(Window,ID_Cancel);
end;
107: begin {Löschen}
Nummer:=SendDlgItemMessage(Window,101,CB_GetCurSel,0,0);
SendDlgItemMessage(Window,101,CB_GetLBText,Nummer,LongInt(@Line));
WritePrivateProfileString(Line,nil,nil,IniName); {aus der .INI löschen}
SendDlgItemMessage(Window,101,CB_DeleteString,Nummer,0); {aus der Liste löschen}
end;
9: WinHelp(Wnd,HelpFile,HELP_CONTEXT,102);
end;
end;
end;
procedure FillEditLines(Editor:HWnd; Puffer:PChar);
{ var
P1,P2: PChar;
Buf: array[0..4095]of Char;}
begin
{ P2:=Puffer; P1:=Buf; {aus #10 ein #13#10 machen}
{ while P2^<>#0 do begin
if P2^=#10 then begin
P1^:=#13; Inc(P1);
end;
P1^:=P2^; Inc(P1); Inc(P2);
end;
P1^:=#0;}
SendMessage(Editor,WM_User+30,0,LongInt(Puffer));
end;
function LoadS(ID: Integer):PChar;
{Nur zur sofortigen Verwendung des Strings bestimmt!}
const
S: array[byte]of Char='';
begin
LoadString(hInstance,ID,S,sizeof(S));
LoadS:=S;
end;
var
RestZeit: LongInt; {Restliche Zeit in Millisekunden}
function HandleTimer:Boolean; {liefert TRUE, wenn Zeit abgelaufen}
var
W: Word;
begin
if RestZeit=0 then HandleTimer:=true
else begin
W:=LongRec(RestZeit).Lo;
if LongRec(RestZeit).Hi<>0 then W:=65535;
Dec(RestZeit,W);
SetTimer(Wnd,10,W,nil);
HandleTimer:=false;
end;
end;
procedure StartTimer; {startet Timer mit <Delay> Sekunden, erlaubt >65s}
begin {Delay=0 bedeutet: kein Timer!}
RestZeit:=ULongMul(Delay,1000);
HandleTimer;
end;
const
Icon: HIcon=0;
function SetIcon(NewID:Word):Boolean;
const
IconID: Word=0;
begin {Ergebnis TRUE bei Žnderung}
SetIcon:=false;
if IconID<>NewID then begin
IconID:=NewID;
if Icon<>0 then begin DestroyIcon(Icon); Icon:=0; end;
Icon:=LoadIcon(HInstance,MakeIntResource(IconID));
if IsIconic(Wnd) then InvalidateRect(Wnd,nil,true);
SetIcon:=true;
end;
end;
const
SysMenu: THandle=0;
procedure ChangeSysMenu;
begin
SysMenu:=GetSystemMenu(Wnd,false); {das Handle}
DeleteMenu(SysMenu,SC_Restore,MF_ByCommand);
DeleteMenu(SysMenu,SC_Maximize,MF_ByCommand);
DeleteMenu(SysMenu,SC_Size,MF_ByCommand);
DeleteMenu(SysMenu,SC_Minimize,MF_ByCommand);
InsertMenu(SysMenu,0,MF_ByPosition or MF_String,201,LoadS(201));
InsertMenu(SysMenu,1,MF_ByPosition or MF_String,203,LoadS(203));
InsertMenu(SysMenu,2,MF_ByPosition or MF_String,202,LoadS(202));
InsertMenu(SysMenu,3,MF_ByPosition or MF_String,9,LoadS(9));
InsertMenu(SysMenu,4,MF_ByPosition or MF_String,909,LoadS(909));
end;
const
WM_WinsockNotify=WM_User+16; {Ende Asynchrone Socket-Verbindung}
WM_GotHostEnt=WM_User+18; {Ende asynchrones GetHostEnt}
WM_WinsockConnect=WM_User+19; {Ende Asynchrone Socket-Verbindung}
function SetNewServer:Boolean;
begin
FingerAllowed:=false;
CheckMenuItem(SysMenu,203,MF_ByCommand or MF_UnChecked);
SetWindowText(Wnd,Sektion);
SetIcon(100); {ein Ruhicon laden}
WSAAsyncGetHostByName(Wnd,WM_GotHostEnt,ServerName,
Remote_Host_Buffer,sizeof(Remote_Host_Buffer));
SetNewServer:=true;
end;
function StartFinger:Boolean;
var
S: array[byte]of Char;
begin
StartFinger:=true;
if FingerAllowed then begin
FingerAllowed:=false;
GetWindowText(Wnd,S,sizeof(S));
SetWindowText(Wnd,'FINGER');
FlashWindow(Wnd,true);
CreateSocket;
WSAAsyncSelect(FingerSocket,Wnd,WM_WinsockNotify,
FD_Read or FD_Write or FD_Connect or FD_Close);
if ConnectSocket=false then begin
SP:=ServerName;
wvsprintf(S,LoadS(1002),SP);
MessageBox(Wnd,S,nil,MB_OK or MB_IconExclamation);
Puffer[0]:=#0; {Puffer leeren}
CheckMenuItem(SysMenu,202,MF_ByCommand or MF_UnChecked); {H„kchen weg}
StartFinger:=false;
end;
end else begin
StartFinger:=false; {Konnte nicht FINGERn wegen Reentranz-Problem!}
end;
end;
function EndFinger:Boolean;
var
S: array[0..4] of Char;
begin
CheckMenuItem(SysMenu,202,MF_ByCommand or MF_Checked); {H„kchen set}
if hShowString<>0 then
FillEditLines(hShowString,Puffer);
if MyStrPos(Puffer,SearchString,SRFlags)<>nil then begin
if SetIcon(101) then begin {SetIcon: F„hnchen klappt hoch?}
FileSplit(ExecName,nil,nil,S);
if lStrCmpi(S,'.WAV')=0 then begin
if sndPlaySound(ExecName,SND_ASYNC)=false then begin
MessageBeep(MB_IconExclamation); {1* Beep}
MessageBox(Wnd,LoadS(1003),
nil,MB_OK or MB_IconExclamation);
end;
end else begin
MessageBeep(MB_IconExclamation);
if lStrLen(ExecName)>0 then begin
SetTimer(Wnd,11,3*1000,nil); {Verzögertes Starten der Anwendung!}
end;
MessageBeep(MB_IconExclamation); {2* Beep}
end;
end;
end else begin
SetIcon(100); {Ruh-Icon}
end;
FingerAllowed:=true;
FlashWindow(Wnd,false);
SetWindowText(Wnd,Sektion);
StartTimer;
end;
function WindowProc(Window:HWnd; Message,wParam:Word; lParam:LongInt):LongInt; export;
var
S: array[0..255]of Char;
W: Word;
TwoSP: array[0..1] of PChar;
PS: TPaintStruct absolute s;
LogFont: TLogFont absolute s;
begin
asm
pusha
push es
end;
WindowProc:=0;
case Message of
WM_Create: begin
Wnd:=Window;
if lStrLen(CmdLine)>0 then lStrCpy(Sektion,CmdLine) {u.U. mehrere Wörter!}
else lStrCpy(Sektion,'Finger Default');
ChangeSysMenu;
LoadSettings(Sektion); {Lade INI-Werte}
if WSAStartup(myVerReqd,myWSAData)<>0 then begin
MessageBox(Window,LoadS(1001),nil, MB_OK or MB_IconStop);
DestroyWindow(Window);
end;
SetNewServer;
{ CreateSocket;
MessageBeep(Word(-1));}
{nicht gleich fingern, um Startlast beim Start von Windows zu verringern}
end;
{***** Eigene Kommandos ****}
{*****}
{*****}
WM_WinsockNotify: begin
{wParam=Socket,
WSAGetSelectEvent(lParam)=Ereignis (LOWORD),
WSAGetSelectError(lParam)=Fehlercode (HIWORD)}
{Ereignis-Reihenfolge bei mir: Write-Connect-Close-Read}
{ wvsprintf(S,'lParam=%lx',lParam);}
{ MessageBox(Window,S,'Huhu!',0);}
case WSAGetSelectEvent(lParam) of
FD_Read: ReceiveStringPiece;{weitere Zeichen lesen}
FD_Write: ;
FD_Connect: begin
{ SetWindowText(Window,S);}
SendUser(UserName);
end;
FD_Close: begin {Übertragung beendet}
{ SetWindowText(Window,S);}
ReceiveStringPiece;
DestroySocket;
if WSAGetSelectError(lParam)=0 then begin
EndFinger;
end else begin
{ MessageBeep(Word(-1)); {Erst einmal}
end;
end;
end;
end;
WM_GotHostEnt: begin
{wParam=THandle,
WSAGETASYNCERROR(lParam)=HIWORD(lParam)=Fehlercode (0=OK)
WSAGETASYNCBUFLEN(lParam)=LOWORD(lParam)=Benötigte Pufferlänge}
{ MessageBeep(Word(-1)); {Erst einmal}
if WSAGetAsyncError(lParam)=0 then begin
FingerAllowed:=true;
CheckMenuItem(SysMenu,203,MF_ByCommand or MF_Checked); {Häkchen setzen}
StartTimer;
end;
end;
WM_QueryOpen: begin
KillTimer(Window,10);
SendMessage(Window,WM_Timer,10,0); {Gleich fingern!}
end; {Fingern!}
{*****System-Kommandos******}
WM_Command, WM_SysCommand: begin
case WParam of
201: begin
FingerAllowed:=false; {Nie im Hintergrund der Dialogbox herumfingern!}
if DialogBox(HInstance,MakeIntResource(201),Window,@KonfProc)=IDOK then begin
CheckMenuItem(SysMenu,202,MF_ByCommand or MF_UnChecked); {Häkchen löschen}
Puffer[0]:=#0; {Puffer leeren}
FingerAllowed:=true;
if not SetNewServer then exit;
KillTimer(Window,10);
SendMessage(Window,WM_Timer,10,0); {Gleich fingern!}
end else FingerAllowed:=true;
end;
202: begin
{ MessageBox(Window,Puffer,'Letzter Finger-String',MB_OK);}
if hShowString=0 then begin
GetObject(GetStockObject(ANSI_Fixed_Font),sizeof(LogFont),
@LogFont);
LogFont.lfWidth:=Abs(LogFont.lfWidth)*80+2*
GetSystemMetrics(SM_CXBorder);
LogFont.lfHeight:=Abs(LogFont.lfHeight)*6+2*
GetSystemMetrics(SM_CYBorder)+GetSystemMetrics(SM_CYCaption);
hShowString:=CreateWindow(HuhuWndClass,LoadS(1004),
WS_OverlappedWindow,
0,10,LogFont.lfWidth,LogFont.lfHeight,
Window,0,hInstance,@Puffer);
end;
FillEditLines(hShowString,Puffer);
ShowWindow(hShowString,SW_ShowNormal); {hochholen}
end;
203: begin
if FingerAllowed then begin
TwoSP[0]:=Remote_Host.h_name;
TwoSP[1]:=Inet_ntoa(PDWord(Remote_Host.h_addr_list^)^);
wvsprintf(S,LoadS(1005),TwoSP);
end else begin
TwoSP[0]:=ServerName;
TwoSP[1]:=PChar(WSAGetLastError);
wvsprintf(S,LoadS(1006),TwoSP);
end;
MessageBox(Window,S,LoadS(1007),MB_OK);
end;
909: DialogBox(HInstance,MakeIntResource(909),Window,@AboutProc);
9: WinHelp(Wnd,HelpFile,HELP_Index,0);
else WindowProc:=DefWindowProc(Window,Message,wParam,lParam);
end{case};
end;
{*****}
WM_Timer: case wParam of
10: begin
KillTimer(Window,10);
if HandleTimer then
{ MessageBeep(Word(-1)); {DEBUG}
if not StartFinger then exit; {Fehler - kein TimerRestart!}
end{10:};
11: begin
KillTimer(Window,11);
W:=WinExec(ExecName,ExecCmd);
if W<32 then begin
TwoSP[0]:=PChar(W); {Achtung - da wird ein Longint draus!}
TwoSP[1]:=ExecName;
wvsprintf(S,LoadS(1008),TwoSP);
MessageBox(Window,S,nil,MB_OK or MB_IconExclamation);
end;
end{11:};
end{case};
{*****}
WM_Paint:
{ if IsIconic(Window) then} begin
BeginPaint(Window,PS);
DefWindowProc(Window,WM_IconEraseBkgnd,PS.hDC,0);
{Es lebe die MSDN-CD Vol. 6, sponsored by Marek Gadau, Sektion Physik}
DrawIcon(PS.hDC,0,0,Icon);
EndPaint(Window,PS);
end {else WindowProc:=DefWindowProc(Window,Message,wParam,lParam)};
{*****}
WM_QueryDragIcon: begin
WindowProc:=Icon;
end;
{*****}
{ WM_ParentNotify: begin
MessageBeep(word(-1));
if (wParam=WM_Destroy) and (LoWord(lParam)=hShowString)
then hShowString:=0; {Fenster beendet markieren!}
{ WindowProc:=DefWindowProc(Window,Message,wParam,lParam);}
WM_User+31: begin
{ MessageBeep(word(-1));}
hShowString:=0;
end;
{*****}
WM_Destroy: begin
KillTimer(Window,10);
{ DestroySocket;}
Cleanup;
WinHelp(Wnd,HelpFile,HELP_Quit,0);
PostQuitMessage(0);
end;
else WindowProc:=DefWindowProc(Window,Message,wParam,lParam);
end;
asm
pop es
popa {vielleicht läßt sich TWSK davon überzeugen?}
end;
end;
procedure Register;
const
wc:TWndClass=(
style: CS_VRedraw or CS_HRedraw;
lpfnWndProc: @WindowProc;
cbClsExtra: 0;
cbWndExtra: 0;
hInstance: Seg(HInstance);
hIcon: 0;
hCursor: 0;
hbrBackGround: Color_Background+1;
lpszMenuName: nil;
lpszClassName: MainWndClass);
begin
if HPrevInst<>0 then exit;
WC.hCursor:=LoadCursor(0,IDC_Arrow);
if not RegisterClass(WC) then Halt(255);
WC.lpszClassName :=HuhuWndClass;
WC.lpfnWndProc :=@ShowStringProc;
WC.hIcon :=LoadIcon(0,IDI_ASTERISK);
if not RegisterClass(WC) then Halt(255);
end;
var
Message:TMsg;
Window:HWnd;
s: array[byte]of Char;
begin
Register;
Window:=CreateWindow{Ex}({WS_Ex_Transparent,}MainWndClass,nil,
WS_Overlapped or WS_Visible or WS_Minimize or WS_ClipSiblings
or WS_Caption or WS_SysMenu,
CW_UseDefault,CW_UseDefault,CW_UseDefault,CW_UseDefault,
0,0,HInstance,nil);
{ wvsprintf(s,'Fensterhandle=%d',Window);
MessageBox(0,s,'Finger1',0);
{ ShowWindow(Window,SW_ShowNormal);
UpdateWindow(Window); {komisch, diesmal muß es hin}
while GetMessage(Message,0,0,0) do begin
TranslateMessage(Message);
DispatchMessage(Message);
end;
{ MessageBox(0,'Ende','Ende',MB_IconStop);}
Halt(Message.wParam);
end.
| Detected encoding: ANSI (CP1252) | 4
|
|
|