'========================================================================================== Function TCPThread() As Long Local hThread As Long Local lResult As Long Local MyThread As Long MyThread = 1 Thread Create TCPThreadProc(ByVal MyThread) To hThread Thread Close hThread To lResult 'WaitForSingleObject hThread,%INFINITE Function = hThread End Function '========================================================================================== Function TCPThreadProc() As Long Static hTcp As Dword Static nServer As Long Static nServerIP As Long Static tcpCount As Long Local lResult As Long Local sBuffer As String Local sPacket As String Local sTmp As String Local lHost As String Select Case CbMsg
Tweet
FUNCTION WinMain
DIALOG NEW ....... to hDlg
Control add stufff
THREAD CREATE TCPFunction (BYVAL hDlg), SUSPEND to hThread
DIALOG SET USER hDlg, 1, hThread
DIALOG SHOW somehow CALL DialogProc
Message loop if somehow=modeless
END FUNCTION
FUNCTION TCPFunction (BYVAL hDlg AS LONG ) AS LONG
TCP Stuff
to update display
CONTROL SET TEXT hDlg , %ID_CONTROL, "progress message"
' all done
DIALOG POST hDlg, %WM_CLOSE, %NULL, %NULL
END FUNCTION
CALLBACK FUNCTION DialogProc
LOCAL hThread
SELECT CASE msg
CASE WM_INITDIALOG
' do necessary stuff here
DIALOG GET USER CBHNDL, 1 to hThread
THREAD RESUME hThread
CASE %WM_SYSCOMMAND
if CBWPARAM AND &hFFF0 = %SC_CLOSE THEN
DIALOG GET USER CBHNDL, 1 TO hThread
THREAD STATUS hThread to iStatus
if iStatus = %STILL_RUNNING ( &h103???) THEN
MSGBOX "Can't quit now, TCP function still running
FUNCTION = %TRUE ' don't allow default action
EXIT FUNCTION
end if
end if
CASE WM_CLOSE
DIALOG END CBHNDL, some_return_value
....
CallBack Function DialogProc() As Long
Static hTcp As Dword
Static nServer As Long
Static nServerIP As Long
Static tcpCount As Long
Local lResult As Long
Local sBuffer As String
Local sPacket As String
Local sTmp As String
Local lHost As String
Static ti As NOTIFYICONDATA
Select Case CbMsg
Case %WM_INITDIALOG
'Set timer to refresh the page EVERY 1 min
SetTimer CbHndl, %IDT_TIMER1, 60000, ByVal %NULL
Control Handle CbHndl,%IDLABEL1 To g_lblHandle
Control Handle CbHndl,%IDTEXT1 To g_txtHandle
Control Handle CbHndl, %IDSTATUSBAR To g_hStatus
' Initialization handler
Graphic Attach CbHndl,%IDC_GC1,ReDraw
Graphic Color %Red,%Yellow
Graphic Clear
Graphic ReDraw
Call CylonEyeThread()
'Running in System Tray?
If IsTrue g_RuninSysTray Then
' ** Add tray icon
ti.cbSize = SizeOf(ti)
ti.hWnd = CbHndl
ti.uID = g_hInst
ti.uFlags = %NIF_ICON Or %NIF_MESSAGE Or %NIF_TIP
ti.uCallbackMessage = %WM_TRAYICON
ti.hIcon = g_hIcon
ti.szTip = g_szMine & " " & g_szVer
Shell_NotifyIcon %NIM_ADD, ti
DestroyIcon ti.hIcon
End If
If IsTrue g_StayOnTop Then 'Stay on top or not
SetWindowPos CbHndl, %HWND_TOPMOST, 0, 0, 0, 0, %SWP_NOMOVE Or %SWP_NOSIZE
Else
SetWindowPos CbHndl, %HWND_NOTOPMOST, 0, 0, 0, 0, %SWP_NOMOVE Or %SWP_NOSIZE
End If
If IsFalse Len(g_ServerIP) Then nServerIP = CCSServerIP(g_Port)
' g_ServerIP is set at that function
'Write to log file:
UpdateLogfile "#Software: " & g_szMine & " " & g_szVer,%FALSE,%TRUE,%FALSE
UpdateLogFile "#Date: " & TimeStamp(),%FALSE,%TRUE,%FALSE
UpdateLogFile "#Fields: date time s-ip cs-method s-port c-ip cs(User-Agent) cs(Referer) sc-bytes cs-bytes",%FALSE,%TRUE,%FALSE
nServer = FreeFile
Tcp Open Server Addr nServerIP Port g_Port As nServer TimeOut g_TimeOut
If Err Then
sBuffer = "Couldn't create socket!"
Control Set Text CbHndl,%IDLABEL1, sBuffer
Else
Tcp Notify nServer, Accept To g_hDlg As %TCP_ACCEPT
sBuffer = "Listening on port " & Format$(g_Port)
Control Set Text CbHndl,%IDLABEL1, sBuffer
End If
'LogEvent sBuffer
hTcp = %INVALID_SOCKET
Function = 1
Case %TCP_ACCEPT
Select Case Lo(Word, CbLParam)
Case %FD_ACCEPT
hTcp = FreeFile
Tcp Accept nServer As hTcp
Tcp Notify hTcp, Recv Close To g_hDlg As %TCP_ECHO
End Select
Function = 1
Case %TCP_ECHO
Select Case Lo(Word, CbLParam)
Case %FD_READ
If hTcp <> %INVALID_SOCKET Then
Incr tcpCount
Control Set Text CbHndl,%IDTEXT1, "Connection established"
Control Set Text CbHndl,%IDCONNLABELTL, Format$(tcpCount,"")
' Perform a receive-loop until there is no data left (ie, the end of stream)
sBuffer = ""
sPacket = ""
Do
Tcp Recv hTcp, 1024, sBuffer
sPacket = sPacket + sBuffer
If Len(sPacket) > 4096 Then Exit Do 'Buffer overflow prevention
Loop Until sBuffer = "" Or IsTrue Eof(hTcp) Or IsTrue Err
'---<DEBUG>-------------------------------------
' Local hFile As Long
' Open AppPath & "Debug.log" For Append As #hFile
' Print #hFile, sPacket
' Close #hFile
'----------------------------------------------
sPacket = Left$(sPacket,Len(sPacket)-2) & String$(50,"-")
SendMessage g_txtHandle , %WM_SETTEXT, 0, StrPtr(sPacket)
Call ParseAndUpdateLogfile(ByVal sPacket,ByVal hTcp) 'Updates window
'local nClient as long
'nClient = RemoteIp (ByVal hTcp)
' Send it back!
Tcp Send hTcp, "HTTP/1.1 200"
Tcp Send hTcp, "Server: " & g_szMine
Tcp Send hTcp, "Date: " & GetPCTimeandDate()
Tcp Send hTcp, "Content-Type: text/xml"
Tcp Send hTcp, "Content-Length: " & Format$(Len(g_BBSDown))
Tcp Send hTcp, g_BBSDown
Tcp Close hTcp
hTcp = %INVALID_SOCKET
'End connection here
Else
'LogEvent "* FD_READ Error!"
End If
Case %FD_CLOSE
Tcp Close hTcp
hTcp = %INVALID_SOCKET
End Select
Function = 1
Comment