Attached is a simplified Web Server utilizing SimpleServer. I started with CVMichael's simple HTTP Web Server (2), simplified it further, and substituted SimpleServer for the MS Winsock Control.
The intent was to create a remote picture viewer utilizing a Web Browser. This enables you to share pictures and other files via the Internet.
When activated, the program will load some default values, so you will need to run "SETUP". The first item to setup is the Shared Directory. This directory must end with a \.
The next item is the Port to listen on. This can be any number from 0 to 65535, but I would recommend a number between 1000 and 10000. Low numbers are used by public servers, and high numbers are used by the operating system.
Next is the Maximum Connections. This is the number of simultaneous connections allowed. I have defaulted to 10, but that number is quite high for this application. 5 should be quite adequate.
Next is the IP version. If you are using IPv6, this should be 6 instead of 4.
Restart the program for the changes to take effect.
To test the program, direct your browser to the port you have assigned (eg. localhost:8080).
To allow access from the outside world, you will need to configure your router to forward the port you have selected to your computer. To do this, you will also need to use a fixed IP address.
Although this application was developed as a picture viewer, it should support any file that your browser supports.
J.A. Coutts
Updated: 07/31/2021
Updated: 06/15/2021
Last edited by couttsj; Aug 15th, 2021 at 08:48 PM.
I found some problems.
if you create folders you can only navigate up to two subfolders.
and if the file or folder name has a different character it doesn't work well that I couldn't test well.
If you want to improve the program I would add the following.
when you click on a file a pop-up window or a modal window opens on the same page showing the image and for example if it is a video with adding the tags <video src = "rabbit.avi"> </video> or audio <audio controls></audio>
it could be seen perfectly.
I found some problems.
if you create folders you can only navigate up to two subfolders.
and if the file or folder name has a different character it doesn't work well that I couldn't test well.
If you want to improve the program I would add the following.
when you click on a file a pop-up window or a modal window opens on the same page showing the image and for example if it is a video with adding the tags <video src = "rabbit.avi"> </video> or audio <audio controls></audio>
it could be seen perfectly.
a greeting
I am not sure I know what you mean about sub folders. I created 5 sub directories without a problem. If by different character you mean Unicode character, then yes it does not support Unicode.
PicServer is only a delivery system. The browser controls the display. If you need special functions, you could always prepare your own web page. For example I made this page for testing:
Addendum: Found another problem when recovering a file at the third level. This one is going to take a little longer, as it is coming from the browser.
Last edited by couttsj; Jul 30th, 2021 at 03:25 PM.
it is a pleasure to test.
I've already made minimal modifications for me.
Another problem is the spaces that the browser changes for
%20 and then it gives an error with the folders
I don't know if there will be more characters that the browser replaces
it is a pleasure to test.
I've already made minimal modifications for me.
Another problem is the spaces that the browser changes for
%20 and then it gives an error with the folders
I don't know if there will be more characters that the browser replaces
Code:
Directory = Replace(Directory, "%20", " ")
great job as always
I had forgotten that I left that in there, as I never understood its full purpose. When would we encounter the string "%20" and what kind of problem would it create? I personally try to avoid directory and file names with spaces. It is better to use "_" than " ".
I am afraid that I cannot read that. You will need to provide more info.
J.A. Coutts
Addendum:
Since I cannot read anything on the screenshot, I suggest that you start smaller and highlight, copy and post just the text on the first browser page after connection. For example, on my system:
-----------------------------
Directories:
dir2
pictures
I am afraid that I cannot read that. You will need to provide more info.
J.A. Coutts
Addendum:
Since I cannot read anything on the screenshot, I suggest that you start smaller and highlight, copy and post just the text on the first browser page after connection. For example, on my system:
-----------------------------
Directories:
dir2
pictures
Public Function StrToByte(strInput As String) As Byte()
Dim lPntr As Long
Dim bTmp() As Byte
Dim bArray() As Byte
If Len(strInput) = 0 Then Exit Function
ReDim bTmp(LenB(strInput) - 1) 'Memory length
ReDim bArray(Len(strInput) - 1) 'String length
CopyMemory bTmp(0), ByVal StrPtr(strInput), LenB(strInput)
'Examine every second byte
For lPntr = 0 To UBound(bArray)
If bTmp(lPntr * 2 + 1) > 0 Then
'bArray(lPntr) = Asc(Mid$(strInput, lPntr + 1, 1))
StrToByte = bTmp
Exit Function
Else
bArray(lPntr) = bTmp(lPntr * 2)
End If
Next lPntr
StrToByte = bArray
End Function Code:
Public Function StrToByte(strInput As String) As Byte()
this function have bug .If the folder or picture contains a Chinese name or other Unicode name, it will fail
As stated in post #4, PicServer does not support Unicode. Please feel free to adjust the code to suit your needs.
After having another look at the problem, it may be as easy as changing a line in the SendData routine:
Code:
bBuffer = StrToByte(CInfo(Index).DataStr)
to
bBuffer = UniToByte(CInfo(Index).DataStr)
I did not use it originally because I was not sure how the browser would interpret it, and unfortunately, I have no way of testing it on actual Unicode data.
it is a pleasure to test.
I've already made minimal modifications for me.
Another problem is the spaces that the browser changes for
%20 and then it gives an error with the folders
I don't know if there will be more characters that the browser replaces
Code:
Directory = Replace(Directory, "%20", " ")
great job as always
Since I don't use spaces in File or directory names, I had to guess where this problem arose. It appears that when a browser encounters a space in a link, it substitutes "%20" when returning the request, which is supposed to stand for a Hex 20. When PicServer received that request, it had to translate it back to a space to be able to find the file or directory. A line was added to the ProcessRequest routine to enable this.
In theory, PicServer has been updated to accept non-Latin character sets. I say in theory because it was extremely difficult for me to test properly. The best I could do was to produce specially fabricated Unicode strings. It has not been tested in a real world non-Latin environment.
Outgoing string pages had to be converted to UTF-8, and incoming responses had to be converted from UTF-8 back to string. I was under the impression that Web browsers defaulted to UTF-8 because they accepted both ASCII and Unicode ASCII (UFT-16) strings, but such was not the case. I had to add an HTML command <meta charset="UTF-8"> to the directory list page.
Would you mind if I added authentication to this code ?
TIA
BTW - I'm not going to leave this hole in our FW for very long, so if you don't read this for a few days/weeks you might need to IM me and I will reinstate !!!
Would you mind if I added authentication to this code ?
TIA
BTW - I'm not going to leave this hole in our FW for very long, so if you don't read this for a few days/weeks you might need to IM me and I will reinstate !!!
No problem. I intend to add TLS 1.3 myself. BTW, the link times out.
Should have mentioned I have already changed the code so it uses a .ini file in the default for the 4 x params.
Orig Code
If IsService Then
Else
sTmp = GetSetting(gAppName, "Settings", "SharePath", "")
End If
If Len(sTmp) = 0 Then
SharePath = App.Path
Else
SharePath = sTmp
End If
If IsService Then
Else
sTmp = GetSetting(gAppName, "Settings", "Port", "")
End If
If Len(sTmp) = 0 Then
PortListen = 8080
Else
PortListen = CLng(sTmp)
End If
If IsService Then
Else
sTmp = GetSetting(gAppName, "Settings", "MaxConnect", "")
End If
If Val(sTmp) = 0 Then
Max_Connect = 10
Else
Max_Connect = Val(sTmp)
End If
IPVersion = GetSetting(gAppName, "Settings", "IPVersion", "4")
in Function LocalInit()
I will wait for you to add TLS and then I will add my auth. code in a module that will only works if it finds the .ini file as I will need to add some of my own params at image activation into mem.
G'Day
Would you mind if I added authentication to this code ?
TIA
I may have misunderstood your question here. Are you talking about password protection or encryption? If password protection, are you talking about individual or group passwords?
"Asking for a Username and Password then validate against AD to auth."
I have done something similar in the past using an Access database. In that case I controlled both ends. In this case it would have to be done in HTML code using a POST command. I have not yet provided support for POST.
"Why does the code look for a favicon.ico file ?"
The code doesn't look for it; the browser does. It places the Icon if supplied next to the URL.
"Is it still timing out?"
Yes. That indicates that it is having trouble establishing a connection. Has the port been forwarded? Port 8080 is not the best selection, as it may be used by another app.
For a simple authentication system I use cookies.
I rescue them from the header.
a greeting
Can you elaborate? I have zero experience with cookies. It seems to me that I would still have to instruct the browser to save the encrypted/encoded password supplied by the user.
and refresh or navigate in web the username is in cookies
it is a very ugly code.
Code:
Private m_headersColl As Collection
Private m_CookiesColl As Collection
Friend Sub Headers()
Dim i As Integer
Dim ci As Integer
Dim m_headers() As String
Set m_headersColl = New Collection
Set m_CookiesColl = New Collection
Dim cookiesarray() As String
Dim strParts() As String
m_headers = Split(sInBuffer, vbNewLine)
For i = 0 To UBound(m_headers)
On Error Resume Next
strParts = Split(m_headers(i), ":", 2)
m_headersColl.Add strParts(1), CStr(strParts(0))
Next
Erase strParts
If Exists(m_headersColl, "Cookie") Then
cookiesarray = Split(m_headersColl("Cookie"), ";")
For ci = 0 To UBound(cookiesarray)
On Error Resume Next
strParts = Split(cookiesarray(ci), "=")
m_CookiesColl.Add CStr(strParts(1)), UCase$(Replace(CStr(strParts(0)), " ", ""))
Next
End If
End Sub
Friend Function cookie(name As String) As String
On Error Resume Next
cookie = m_CookiesColl(UCase$(name))
End Function
Private Function Exists(ByVal oCol As Collection, ByVal vKey As Variant) As Boolean
On Error Resume Next
oCol.Item vKey
Exists = (Err.Number = 0)
Err.Clear
End Function