S" SAMPLES\THREAD.TXT"  INCLUDED
S" SAMPLES\SOCKETS.TXT" INCLUDED
\ S" SAMPLES\PROCESS.TXT" INCLUDED

WINAPI: StartServiceCtrlDispatcherA ADVAPI32.DLL
WINAPI: CreateServiceA              ADVAPI32.DLL
WINAPI: OpenSCManagerA              ADVAPI32.DLL
WINAPI: RegisterServiceCtrlHandlerA ADVAPI32.DLL
WINAPI: SetServiceStatus            ADVAPI32.DLL
WINAPI: SetCurrentDirectoryA        KERNEL32.DLL

0
4 -- dwServiceType
4 -- dwCurrentState
4 -- dwControlsAccepted
4 -- dwWin32ExitCode
4 -- dwServiceSpecificExitCode
4 -- dwCheckPoint
4 -- dwWaitHint
CONSTANT /SERVICE_STATUS

HEX 1FF CONSTANT SERVICE_ALL_ACCESS
     3F CONSTANT SC_MANAGER_ALL_ACCESS
     10 CONSTANT SERVICE_WIN32_OWN_PROCESS
     30 CONSTANT SERVICE_WIN32
      1 CONSTANT SERVICE_ERROR_NORMAL
      3 CONSTANT SERVICE_DEMAND_START
      2 CONSTANT S_AUTO
      4 CONSTANT SERVICE_RUNNING
DECIMAL

CREATE SERVICE_STATUS /SERVICE_STATUS ALLOT
SERVICE_STATUS /SERVICE_STATUS ERASE

: (ServiceControlHandler)
  DROP
\  0 <# # # # # #  # # # # # #> 2DUP + 0! R/W CREATE-FILE DROP
\  CLOSE-FILE DROP
;
' (ServiceControlHandler) WNDPROC: ServiceControlHandler

VARIABLE CUR-TALK
: READ-TO-CR. ( s -- )
  #TIB 0! >IN 0!
  >R
  BEGIN
    TIB #TIB @ + 1 R@ ReadSocket THROW 1 =
    TIB #TIB @ + C@ 13 <> AND
  WHILE
    TIB #TIB @ + C@ EMIT #TIB 1+!
  REPEAT TIB #TIB @ + 1 R@ ReadSocket THROW DROP CR
  R> DROP
;
: />\ ( addr u -- )
  0 ?DO DUP I + C@ [CHAR] / = IF [CHAR] \ OVER I + C! THEN LOOP DROP
;
: WEB-ANSWER ( addr u R -- )
  >R
  2DUP />\ 
  TIB >R >IN @ >R #TIB @ >R
  #TIB ! >IN 0! TO TIB
  BL WORD DROP >IN 1+! BL PARSE
  R> #TIB ! R> >IN ! R> TO TIB 2DUP + 0!
  DUP 0= IF DROP S" index.html" DUP >R HERE CELL+ SWAP 1+ MOVE HERE CELL+ R> THEN
  2 + SWAP 2 - [CHAR] . OVER C! [CHAR] \ OVER 1+ C! SWAP
  2DUP TYPE CR
  2DUP R/O OPEN-FILE
  IF DROP S" HTTP/1.0 400 Bad Request" R@ CELL+ @ WriteSocketLine DROP
     S" Content-Type: text/html" R@ CELL+ @ WriteSocketLine DROP
     R@ CELL+ @ WriteSocketCRLF DROP
     S" <BODY><H1>  :</H1></BODY>" R@ CELL+ @ WriteSocketLine DROP
     R> CELL+ @ WriteSocketLine DROP
     EXIT
  THEN NIP NIP
  R@ 4 CELLS + !
  S" HTTP/1.0 200 OK" R@ CELL+ @ WriteSocketLine DROP
  S" Server: SP-Forth-PWS/0.2" R@ CELL+ @ WriteSocketLine DROP
  R@ CELL+ @ WriteSocketCRLF DROP
  BEGIN
    R@ 5 CELLS + 400 R@ 4 CELLS + @ READ-FILE
    IF DROP R> 4 CELLS + @ CLOSE-FILE DROP EXIT THEN
    ?DUP
  WHILE
    R@ 5 CELLS + SWAP R@ CELL+ @ WriteSocket DROP
  REPEAT
\  R@ CELL+ @ DUP DUP TO H-STDOUT TO H-STDIN TO H-STDERR
\  S" CMD /C DIR" start2
  R> 4 CELLS + @ CLOSE-FILE DROP
;
CREATE CRLFCRLF 13 C, 10 C, 13 C, 10 C,
VARIABLE CLIENTS-LIST

: WEB-THREAD
  INIT-THREAD
  500 ALLOCATE DROP >R
  CLIENTS-LIST @ R@ !
  CUR-TALK @ R@ CELL+ !
  BEGIN
    R@ 2 CELLS + 0!
    BEGIN
      R@ 3 CELLS + R@ 2 CELLS + @ +
      500 R@ 2 CELLS + @ -
      R@ CELL+ @ ReadSocket
      IF DROP R@ CELL+ DUP @ CloseSocket DROP 0! 0 R> FREE DROP ExitThread
      ELSE R@ 2 CELLS + +! THEN
      R@ 3 CELLS +  R@ 2 CELLS + @ CRLFCRLF 4 SEARCH NIP NIP
    UNTIL
    R@ 3 CELLS +  R@ 2 CELLS + @ ( 2DUP TYPE CR) R@ WEB-ANSWER
    R@ CELL+ @ CloseSocket DROP R@ FREE DROP 0 ExitThread
  AGAIN
  R> DROP 0
;
: (ServiceMain) ( dwArgc *lpszArgv -- )
  2DROP
  S" ss2.log" R/W CREATE-FILE IF DROP ELSE TO H-STDOUT THEN
  SERVICE_WIN32 SERVICE_STATUS dwServiceType !
  SERVICE_RUNNING SERVICE_STATUS dwCurrentState !

  ['] ServiceControlHandler S" SAMPLE SERVICE" DROP
  RegisterServiceCtrlHandlerA
  SERVICE_STATUS SWAP SetServiceStatus DROP
\  S" TEST.SERVICE4" R/W CREATE-FILE DROP CLOSE-FILE DROP
  C/L 2+ ALLOCATE IF BYE ELSE TO TIB THEN
  SocketsStartup DROP
  CreateSocket DROP >R
  8080 R@ BindSocket DROP
  R@ ListenSocket DROP
  BEGIN
    R@ AcceptSocket DROP CUR-TALK !
    ['] WEB-THREAD CREATE-THREAD DROP 1000000 0 DO NOOP LOOP 
  AGAIN
  R> DROP 
  BEGIN AGAIN
;
' (ServiceMain) WNDPROC: ServiceMain

HERE S" SAMPLE SERVICE" HERE SWAP DUP ALLOT MOVE 0 C,
CREATE SERVICE_TABLE , ' ServiceMain , 0 , 0 ,

: CreateService
  0 0 0 0 0 S" C:\PRO\96\SS.EXE \" DROP
  SERVICE_ERROR_NORMAL S_AUTO \ SERVICE_DEMAND_START 
  SERVICE_WIN32_OWN_PROCESS SERVICE_ALL_ACCESS
  S" Fweb" DROP
  S" Fweb" DROP
  SC_MANAGER_ALL_ACCESS 0 0 OpenSCManagerA
  CreateServiceA
;
: Service
  S" ss.tmp" R/W CREATE-FILE 0= IF TO H-STDOUT ELSE BYE THEN
  C/L CELL+ ALLOCATE DROP TO TIB
  GetCommandLineA ASCIIZ>
  TIB SWAP C/L MIN DUP #TIB ! MOVE >IN 0!
  TIB C@ [CHAR] " = IF [CHAR] " ELSE BL THEN
  WORD DROP
  SOURCE TYPE SPACE 1 WORD COUNT OVER + 0!
  SetCurrentDirectoryA . CR
  TIB #TIB @ S" INSTALL" SEARCH IF CreateService ." INSTALLED" BYE ELSE 2DROP THEN
  H-STDOUT CLOSE-FILE THROW
  SERVICE_TABLE StartServiceCtrlDispatcherA DROP
\  S" TEST.SERVICE2" R/W CREATE-FILE DROP CLOSE-FILE DROP
  BYE
;
\ CreateService . (  )

FALSE TO ?GUI FALSE TO ?CONSOLE ' Service DUP MAINX ! TO <MAIN> S" SS.EXE" SAVE BYE
