Windows Service HTTPListener Memory Issue - windows

Im a complete novice to the "best practices" etc of writing in any code.
I tend to just write it an if it works, why fix it.
Well, this way of working is landing me in some hot water. I am writing a simple windows service to server a single webpage. (This service will be incorperated in to another project which monitors the services and some folders on a group of servers.)
My problem is that whenever a request is recieved, the memory usage jumps up by a few K per request and keeps qoing up on every request.
Now ive found that by putting GC.Collect in the mix it stops at a certain number but im sure its not meant to be used this way. I was wondering if i am missing something or not doing something i should to free up memory.
Here is the code:
Public Class SimpleWebService : Inherits ServiceBase
'Set the values for the different event log types.
Public Const EVENT_ERROR As Integer = 1
Public Const EVENT_WARNING As Integer = 2
Public Const EVENT_INFORMATION As Integer = 4
Public listenerThread As Thread
Dim HTTPListner As HttpListener
Dim blnKeepAlive As Boolean = True
Shared Sub Main()
Dim ServicesToRun As ServiceBase()
ServicesToRun = New ServiceBase() {New SimpleWebService()}
ServiceBase.Run(ServicesToRun)
End Sub
Protected Overrides Sub OnStart(ByVal args As String())
If Not HttpListener.IsSupported Then
CreateEventLogEntry("Windows XP SP2, Server 2003, or higher is required to " & "use the HttpListener class.")
Me.Stop()
End If
Try
listenerThread = New Thread(AddressOf ListenForConnections)
listenerThread.Start()
Catch ex As Exception
CreateEventLogEntry(ex.Message)
End Try
End Sub
Protected Overrides Sub OnStop()
blnKeepAlive = False
End Sub
Private Sub CreateEventLogEntry(ByRef strEventContent As String)
Dim sSource As String
Dim sLog As String
sSource = "Service1"
sLog = "Application"
If Not EventLog.SourceExists(sSource) Then
EventLog.CreateEventSource(sSource, sLog)
End If
Dim ELog As New EventLog(sLog, ".", sSource)
ELog.WriteEntry(strEventContent)
End Sub
Public Sub ListenForConnections()
HTTPListner = New HttpListener
HTTPListner.Prefixes.Add("http://*:1986/")
HTTPListner.Start()
Do While blnKeepAlive
Dim ctx As HttpListenerContext = HTTPListner.GetContext()
Dim HandlerThread As Thread = New Thread(AddressOf ProcessRequest)
HandlerThread.Start(ctx)
HandlerThread = Nothing
Loop
HTTPListner.Stop()
End Sub
Private Sub ProcessRequest(ByVal ctx As HttpListenerContext)
Dim sb As StringBuilder = New StringBuilder
sb.Append("<html><body><h1>Test My Service</h1>")
sb.Append("</body></html>")
Dim buffer() As Byte = Encoding.UTF8.GetBytes(sb.ToString)
ctx.Response.ContentLength64 = buffer.Length
ctx.Response.OutputStream.Write(buffer, 0, buffer.Length)
ctx.Response.OutputStream.Close()
ctx.Response.Close()
sb = Nothing
buffer = Nothing
ctx = Nothing
'This line seems to keep the mem leak down
'System.GC.Collect()
End Sub
End Class
Please feel free to critisise and tear the code apart but please BE KIND. I have admitted I dont tend to follow the best practice when it comes to coding.

You are right, you should not be doing this. Remove the Collect() call and let it run for a week. Any decent .NET book will talk about how the garbage collector works and how it does not immediately release memory when you set an object to Nothing. It doesn't kick in until you've consumed somewhere between 2 and 8 megabytes. This is not a leak, merely effective use of a plentiful resource.
You use a new thread for each individual connection, that's pretty expensive and scales very poorly when you get a lot of connections. Consider using ThreadPool.QueueUserWorkItem instead. Threadpool threads are very cheap and their allocation and execution is well controlled by the threadpool manager.

Related

VB6 Subscript Out fo Range - but this is an odd one because a mirror function is working fine

Thanks for reading.
I have built a VB6 DLL (VB_InterFace just for a name) that talks to a C# DLL (C#_Driver just for a name) that talks to a Bluetooth Device.
The Demo VB6 test app (VB_Demo just for a name) I created as stage one works fine, does what it is supposed to. It calls the VB_Interface and Opens and Closes the BTDevice. Additional functions also work fine.
However on placing the operational code from VB_Interface into another DLL that is the live operations DLL, Open works fine, but Close is throwing an error. "Variable not defined" when returning from the C#_Driver.
I just can't see why, the code is the same, the process is only marginally different. By this I mean ;
In the VB_Demo I have two buttons "Open" "Close" and when I click on these I get the feedback that I expect from the BTDevice.
Private Sub btnOpenPort_Click()
'MsgBox steps(0)
ReDim steps(5)
Dim rc As HF4000_ResultCodes
'rc = driver.OpenSerial(cmbPorts.Text)
If driver.OpenSerial(cmbPorts.Text) = True Then
Private Sub btnClosePort_Click()
Dim rc As HF4000_ResultCodes
If driver.CloseSerial("COM4") = True Then
However in the live DLL it just executes the same functions internally without being initiated by a button click.
' See IScanDevice documentation.
' #see IScanDevice#OpenDevice
Private Function IScanDevice_OpenDevice() As Scanning.Scan_ResultCodes
(truncated slightly)
50 If driver.OpenSerial("COM4") = True Then
rc = READY
MsgBox "Connected to the device successfully."
' See IScanDevice documentation.
' #see IScanDevice#CloseDevice
Private Function IScanDevice_CloseDevice() As Scanning.Scan_ResultCodes
(truncated slightly)
50 If driver.CloseSerial("COM4") = True Then
60 rc = READY
70 IScanDevice_CloseDevice = Scan_Success
clsDriver.cls
Public Event OnStateChanged(newState As String)
Public Event OnDataUpdated()
Dim WithEvents CSharpInteropServiceEvents As CSharpInteropService.LibraryInvoke
Dim load As New LibraryInvoke
Private Sub Class_Initialize()
Set CSharpInteropServiceEvents = load
End Sub
Private Sub CSharpInteropServiceEvents_MessageEvent(ByVal newState As String)
If newState = "OpenForm1" Then
' FormDummy2.Show ' Not required
End If
If State <> newState Then
State = newState
RaiseEvent OnStateChanged(State)
GetDriverData
End If
End Sub
Private Function BluetoothTestInvoke(load, functionName, param)
BluetoothTestInvoke = load.GenericInvoke("BluetoothTest.dll", "BluetoothTest.Class1", functionName, param)
End Function
Function OpenSerial(portNumber) ' "COM4"
Dim param(0) As Variant
Dim retorno As Variant
param(0) = portNumber
retorno = BluetoothTestInvoke(load, "OpenSerial", param)
OpenSerial = retorno(0) <<<<<<< Works fine returns TRUE
End Function
Function CloseSerial(portNumber) ' "COM4"
Dim param(0) As Variant
Dim retorno As Variant
param(0) = portNumber
retorno = BluetoothTestInvoke(load, "CloseSerial", param)
CloseSerial = retorno(0) <<<<<<<<< "Error Subscript Out of Range"
End Function
What I have discovered is this - and I guess this is the reason why the Close is not working. The question is why is this situation occurring ...
When driver.OpenSerial executes, it hits > Function OpenSerial
Within Function OpenSerial it executes BluetoothTestInvoke where "load" is "CSharpInteropService.LibraryInvoke"
From there it moves to - Sub CSharpInteropServiceEvents_MessageEvent
.. and everything is fine.
However when I then execute driver.CloseSerial after that, it hits > Function CloseSerial
Within Function OpenSerial it executes BluetoothTestInvoke where "load" is "CSharpInteropService.LibraryInvoke"
Now here it "should" move to - Sub CSharpInteropServiceEvents_MessageEvent
However No, it just drops to the next line which is CloseSerial = retorno(0)
and this is where I get the "Subscript out of range" error for retorno(0)
For some reason in the CloseSerial it is not invoking "load"
BluetoothTestInvoke(load, "CloseSerial", param)
Thoughts and suggestions much appreciated.
UPDATE
Quite right, one should never assume anything.
On the tips I started digging deeper into the C# Library. It turns out the "param" value that is the Bluetooth port is passed into the CloseSerial call, and from there is is passed around within the external C# library dll. At one stage it is reset so the port number that should be handled is lost, thus it doesn't close but specifically the "expected" data was not returned to the calling app.
param(0) = portNumber
retorno = BluetoothTestInvoke(load, "CloseSerial", param) << param was being reset in the external library.

manualresetevent.waitone is hanging

I have a windows service with a timer. About 3 times a day the timer uploads files to different ftp servers. I set the timer, upload the files, then set the next time. This worked fine for a while, until I added another ftpserver for uploading files. When uploading to that ftpserver the project hangs at manualresetevent.waitone (even though the folder was uploaded)
Here part of the code, let me know if more is needed.
Dim state As New FtpState
Dim request As FtpWebRequest = DirectCast(WebRequest.Create(target), FtpWebRequest)
request.Method = WebRequestMethods.Ftp.UploadFile
request.Credentials = mycredentials
state.Request = request
state.FileName = fileName
' Get the event to wait on.
waitObject = state.OperationComplete
' Asynchronously get the stream for the file contents.
request.BeginGetRequestStream(New AsyncCallback(AddressOf EndGetStreamCallback), state)
' Block the current thread until all operations are complete.
waitObject.WaitOne()
' The operations either completed or threw an exception.
If state.OperationException IsNot Nothing Then
Throw New Exception(state.OperationException.ToString)
Else
Publish.sendMail("Upload completed for filename:" & fileName & state.StatusDescription)
End If
End If
This ftpserver works a little different than the others that I'm using and I'm not sure if thats the cause of the problem.
Here is the difference: I upload a zip folder (not just files) which can be quite large and soon after it's uploaded, it is being moved from that ftpserver.
(Whereas the other ftpservers leave the files on the ftpserver)
I think this problem only started once the zipfolder got larger.
I know that it is uploaded and then deleted from there.
So if the upload completed, why does it get stuck at waitone?
Here my endstreamcallback function
Private Shared Sub EndGetStreamCallback(ByVal ar As IAsyncResult)
Dim state As ftpState = DirectCast(ar.AsyncState, ftpState)
Dim requestStream As Stream = Nothing
' End the asynchronous call to get the request stream.
Try
requestStream = state.Request.EndGetRequestStream(ar)
' Copy the file contents to the request stream.
Const bufferLength As Integer = 2048
Dim buffer As Byte() = New Byte(bufferLength - 1) {}
Dim count As Integer = 0
Dim readBytes As Integer = 0
Dim stream As FileStream = File.OpenRead(state.FileName)
Do
readBytes = stream.Read(buffer, 0, bufferLength)
requestStream.Write(buffer, 0, readBytes)
count += readBytes
Loop While readBytes <> 0
'Console.WriteLine("Writing {0} bytes to the stream.", count)
' IMPORTANT: Close the request stream before sending the request.
requestStream.Close()
' Asynchronously get the response to the upload request.
state.Request.BeginGetResponse(New AsyncCallback(AddressOf EndGetResponseCallback), state)
' Return exceptions to the main application thread.
Catch e As Exception
Publish.sendMail("Could not get the request stream.")
state.OperationException = e
state.OperationComplete.[Set]()
Return
End Try
End Sub
' The EndGetResponseCallback method
' completes a call to BeginGetResponse.
Private Shared Sub EndGetResponseCallback(ByVal ar As IAsyncResult)
Dim state As FtpState = DirectCast(ar.AsyncState, FtpState)
Dim response As FtpWebResponse = Nothing
Try
response = DirectCast(state.Request.EndGetResponse(ar), FtpWebResponse)
response.Close()
state.StatusDescription = response.StatusDescription
' Signal the main application thread that
' the operation is complete.
state.OperationComplete.[Set]()
' Return exceptions to the main application thread.
Catch e As Exception
Publish.sendMail("Error getting response.")
state.OperationException = e
state.OperationComplete.[Set]()
End Try
End Sub

What is the difference between Dim and Public?

A question about scope was raised today and it got me thinking.
I've always understood VBScript scope and how to declare Globally and Locally. It occurred to me though that I never use Public variables but tend to use Dim instead when declaring Globally.
As far as I understood it Dim is the same as Public, but if that's the case why have both of them? Is there a difference between the two and is it good practice to use one over the other?
Update:
This question is aimed purely at VBScript, not VBA and especially in the context of Classic ASP.
Key Differences Between Visual Basic for Applications and VBScript
Access restrictions make sense in modular or object-orientated languages. As Basic started as a simple procedural language, the later addition of such features make strict rules for using Dim, Public, and Private difficult.
Everything below is about VBScript (not VBA, not ASP, not VB.NET)
Facts:
In out of Sub/Function/Class code, Dim, Public, and Private are equivalent: All declarations apply to the global scope
In Subs/Functions/Methods you can use Dim only. The declarations apply to the Func/Sub/Method-local scope
In class definitions, Dim and Public declare variables that are accessible for out-of-classe code; Private creates variables that can be accessed from class-code only. Private methods are callable from class-code only, Public methods (default) can be called from 'outer space'.
Ruleset I:
Use Dim for top-level declarations, because Public/Private have no discernible effect
Use Dim in Subs/Functions/Method, because you must
Use Public or Private (but not Dim) for member variable declarations, because the access permissions are important
Use Private for private methods, but don't bother with Public, because it's the default
Sample code:
Option Explicit
Dim gsDim : gsDim = "gsDim"
Public gsPub : gsPub = "gsPub"
Private gsPriv : gsPriv = "gsPriv"
Class cX
Dim m_sDim
Public m_sPub
Private m_sPriv
Private Sub Class_Initialize()
m_sDim = "m_sDim"
m_sPub = "m_sPub"
m_sPriv = "m_sPriv"
End Sub
Function ToString()
' Public Whatever => syntax error
' Private Whatever => syntax error
Dim Whatever ' => no problem to use Dim for local declaration
ToString = ToStringPriv()
End Function
Private Function ToStringPriv()
ToStringPriv = Join(Array(m_sDim, m_sPub, m_sPriv))
End Function
End Class
Function main()
' Public Whatever => syntax error
' Private Whatever => syntax error
Dim Whatever ' => no problem to use Dim for local declaration
main = 0
WScript.Echo "in func main():", Join(Array(gsDim, gsPub, gsPriv))
Execute "WScript.Echo ""via Execute:"", Join(Array(gsDim, gsPub, gsPriv))"
Dim oX : Set oX = New cX
WScript.Echo "oX.ToString():", oX.ToString()
Dim s
On Error Resume Next
s = oX.ToStringPriv()
WScript.Echo Err.Description
s = oX.m_sPriv
WScript.Echo Err.Description
On Error GoTo 0
End Function
WScript.Echo "top level code:", Join(Array(gsDim, gsPub, gsPriv))
WScript.Quit main()
output:
cscript dimpubpriv.vbs
top level code: gsDim gsPub gsPriv
in func main(): gsDim gsPub gsPriv
via Execute: gsDim gsPub gsPriv
oX.ToString(): m_sDim m_sPub m_sPriv
Object doesn't support this property or method
Object doesn't support this property or method
Update wrt Kul-Tigin's comment:
Ruleset II (when writing code for a host that supports modules):
Treat modules as classes, i.e. apply I.3 and I.4 to your top-level variable rsp. Sub/Function declarations (because now access rights matter/are enforced)
Code:
Option Explicit
Public gsPub : gsPub = "gsPub"
Private gsPriv : gsPriv = "gsPriv"
Class AContext
Public CodeObject
End Class
With (New AContext)
Set .CodeObject = Me
WScript.Echo .CodeObject.gsPub
WScript.Echo .CodeObject.gsPriv
End With
Evidence:
cscript dimpubpriv.vbs
gsPub
... Microsoft VBScript runtime error: Object doesn't support this property or method: 'CodeObject.gsPriv''

Testing application for Administrative Running Rights

I want a sure-shot method to test if the application was run via the UAC box and has full administrative rights. Earlier, I thought of making a folder in C:\Windows\ for testing but running it on other computers proved to be a failure!
The UAC box provides all administrative rights to the computer to do anything(including making folders and creating files in places which needs there rights) and also makes sure that any child program so called or created also does have the same rights as the parent.
Is there a sure-shot way to test if my application has been provided all the administrative rights that I can maximum get by the user while running the application or not? If yes, I would be glad to have to piece of code-work!
C#:
using System.Security.Principal;
...
var identity = WindowsIdentity.GetCurrent();
var principal = new WindowsPrincipal(identity);
bool isElevated = principal.IsInRole(WindowsBuiltInRole.Administrator);
VB.Net:
Imports System.Security.Principal
...
Dim identity = WindowsIdentity.GetCurrent()
Dim principal = new WindowsPrincipal(identity)
Dim isElevated as Boolean = principal.IsInRole(WindowsBuiltInRole.Administrator)
After a fair bit of poking around, I found that the most common solutions to this question return false negatives if the user's UAC is set to anything but Off.
My solution these days is to do this:
Imports System.Security.Principal
Imports System.DirectoryServices.AccountManagement
Imports System.DirectoryServices.ActiveDirectory
Imports Microsoft.VisualBasic.ApplicationServices
''' <summary>Checks whether the current user is belongs to any Administrators groups.</summary>
''' <param name="AuthGroups">Optional. A flag indicating whether to use GetAuthorizationGroups instead of the - faster - GetGroups. Default=true.</param>
''' <returns>True if the user belongs to an Administrators group, false otherwise.</returns>
Public Function IsAdministrator(
Optional ByVal AuthGroups As Boolean = True) As Boolean
Static bResult As Boolean? = Nothing
Try
If bResult Is Nothing Then
bResult = New WindowsPrincipal(WindowsIdentity.GetCurrent()).IsInRole(WindowsBuiltInRole.Administrator)
If Not bResult Then
Dim oContext As PrincipalContext = Nothing
Try 'Domain check first
Domain.GetComputerDomain()
oContext = New PrincipalContext(ContextType.Domain)
Catch
'Fall through to machine check
End Try
If oContext Is Nothing Then oContext = New PrincipalContext(ContextType.Machine)
'Dim oPrincipal As UserPrincipal = UserPrincipal.FindByIdentity(oContext, WindowsIdentity.GetCurrent().Name) ' Don't use - slow
Using oSearchUser As Principal = New UserPrincipal(oContext)
oSearchUser.SamAccountName = WindowsIdentity.GetCurrent().Name
Using oSearcher As PrincipalSearcher = New PrincipalSearcher(oSearchUser)
Using oUser As Principal = oSearcher.FindOne()
If oUser IsNot Nothing Then
If AuthGroups Then
bResult = CType(oUser, UserPrincipal).GetAuthorizationGroups().Any(Function(p) _
p.Sid.IsWellKnown(WellKnownSidType.BuiltinAdministratorsSid) OrElse
p.Sid.IsWellKnown(WellKnownSidType.AccountDomainAdminsSid) OrElse
p.Sid.IsWellKnown(WellKnownSidType.AccountAdministratorSid) OrElse
p.Sid.IsWellKnown(WellKnownSidType.AccountEnterpriseAdminsSid))
Else
bResult = oUser.GetGroups().Any(Function(p) _
p.Sid.IsWellKnown(WellKnownSidType.BuiltinAdministratorsSid) OrElse
p.Sid.IsWellKnown(WellKnownSidType.AccountDomainAdminsSid) OrElse
p.Sid.IsWellKnown(WellKnownSidType.AccountAdministratorSid) OrElse
p.Sid.IsWellKnown(WellKnownSidType.AccountEnterpriseAdminsSid))
End If
End If
End Using
End Using
End Using
End If
End If
Catch
bResult = False
End Try
Return bResult.GetValueOrDefault(False)
End Function
This method is a composite of a few other answers, so I only take credit for packaging it up into a function that will only ever run once and therefore if there is a bit of a delay due to the fall-through, you can probably hide it in start-up.
The AuthGroups argument gives you a choice of the more thorough, recursive AuthorizationGroups check (default) or the faster Groups check.

Is there an easy event in .Net to detect a cd, dvd (or usb) insertion?

I know you can do it with an WMI event or overriding WndProc and looking for the right messages, but i was wondering if there wasn't something hidden in the net framework that makes this task easyer.
This free DriveDetector class provides this functionality (as least for USB drives, which is what I used it for). It uses the WndProc approach you describe.
I'm not aware of anything similar that is part of the standard .NET libraries.
In the following code, moDiskDetector will raise an EventArrived event when a new drive is detected.
To detect removal of a drive use "__InstanceDeletionEvent".
Private WithEvents moDiskAddWatcher As ManagementEventWatcher
Private Sub StartWatcher()
If moDiskAddWatcher Is Nothing Then
moDiskAddWatcher = CreateWatcher("__InstanceCreationEvent", "(TargetInstance ISA 'Win32_DiskDrive')")
End If
moDiskAddWatcher.Start()
End Sub
Private Sub StopWatcher()
If moDiskAddWatcher IsNot Nothing Then
moDiskAddWatcher.Stop()
moDiskAddWatcher.Dispose()
End If
End Sub
Private Function CreateWatcher(ByVal sClassName As String, ByVal sCondition As String) As ManagementEventWatcher
Dim oQuery As New WqlEventQuery()
oQuery.EventClassName = sClassName
oQuery.WithinInterval = New TimeSpan(0, 0, 5)
oQuery.Condition = sCondition
Return New ManagementEventWatcher(oQuery)
End Function

Resources