unit isconnected; interface uses winsock,sysutils,windows,messages,forms,checkhostinthread,dllping; function Checkhost(address : string) : boolean; function runprogram(commandline : string; windowstate : integer;waitfor :boolean) : boolean; procedure writeoskmailslot(s : string); procedure osk(show : boolean;alpha : boolean); procedure initmailslot; function readmailslot : string; var mshand : thandle=0; ms : string; keyboardshowing : boolean = false; implementation procedure initmailslot; begin //mshand:=createmailslot('\.\mailslot\LSRASDIALLER1',0,MAILSLOT_WAIT_FOREVER,nil); end; function readmailslot : string; var messz : cardinal; mescnt,rd : dword; res : array [0..255] of char; begin messz:=0; getmailslotinfo(mshand,nil,messz,@mescnt,nil); result:=''; if (messz<>0) and (mescnt<>0) then begin readfile(mshand,res,messz,rd,nil); result:=res; end; end; procedure osk(show : boolean;alpha : boolean); var ht : integer; begin {$IFNDEF KIOSK} exit; {$ENDIF} ht:=screen.height div 4; if show=true then begin keyboardshowing:=true; if alpha=true then runprogram('emposk.exe '+inttostr(ht)+' 50 35 ALPHA',0,false) else runprogram('emposk.exe '+inttostr(ht)+' 50 35',0,false); end else begin keyboardshowing:=false; writeoskmailslot('close'); end; end; function Checkhost(address : string) : boolean; var StartupData : TWSADATA; ver : word; begin ver:=makeword(2,0); WSAStartup (ver,StartupData); if ping(address)>0 then result:=true else result:=false; WSACleanup; end; {function Checkhost(address : string) : boolean; var ch : checkhostthread; res : integer; begin ch:=checkhostthread.Create(true); ch.address:=address; ch.Resume; res:=ch.waitfor; ch.free; if res=1 then result:=true else result:=false; end; } procedure writeoskmailslot(s : string); var hf : thandle; br : dword; ss : array[0..255] of char; begin strpcopy(ss,s); hf:=createfile('\.\mailslot\LSOSK1',GENERIC_WRITE,FILE_SHARE_READ,nil,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0); if hf=0 then exit; writefile(hf,ss,length(s)+1,br,nil); closehandle(hf); end; function runprogram(commandline : string; windowstate : integer;waitfor :boolean) : boolean; type tenv = pchar; var comline : array [0..255] of char; startupinfo : tstartupinfo; processinfo : tProcessinformation; lpExitcode : cardinal; msg : tmsg; pass : array [0..255] of char; begin strpcopy(comline,commandline); with startupinfo do begin cb := sizeof(startupinfo); lpreserved:=nil; lpdesktop:=nil; lptitle:=nil; dwflags := STARTF_USESHOWWINDOW; lpreserved := nil; cbreserved2 :=0; lpreserved2 := nil; if windowstate=0 then wshowwindow:=sw_normal else wshowwindow:=SW_SHOWMINIMIZED; end; fillchar(pass,sizeof(pass),0); //SetPrivilege('SeAssignPrimaryTokenPrivilege',true); //maybe needed result:=createprocess(nil,comline,nil,nil,false,normal_priority_class, nil,nil,startupinfo,processinfo); if result=true then begin if waitfor=true then begin lpexitcode:=STILL_ACTIVE; while(lpexitcode=STILL_ACTIVE) do begin; while(peekmessage(msg,0,0,0,PM_REMOVE)) do begin If msg.message = WM_QUIT then halt(msg.wparam); TranslateMessage(msg); DispatchMessage(Msg); end; getexitcodeprocess(processinfo.hprocess,lpexitcode); end; end; end; end; end.