how do I limit my website access to USA only, using ASP Classic (windows server). I read about htaccess, but not sure how to implement that to ASP classic programming language.
You can add htaccess-functionality by implementing an IIS-Module (i.e. Helicon Ape) which allows you to set IP-Ranges. Such a module has to be installed on your Windows Webserver (Server 2008 and above) and will be configured in your IIS-Manager. Once this is done you are able to use htaccess in nearly the same way as on an Apache Server.
Another (theoratical) way is to do a server-side check on the remote IP-address.
First you need to retrieve the remote IP-address
remote_addr = Request.ServerVariables("REMOTE_ADDR");
Then you can compare against given ranges
function compareIps(ip, lowrange, highrange)
dim octetIPArray(4) as integer, octetIPLowArray(4) as integer, octetIPHighArray(4) as integer
compareIps = False
octetArray = split(ip, '.', -1, vbtextcompare)
octetIPLowArray = split(lowrange, '.', -1, vbtextcompare)
octetIPHighArray = split(highrange, '.', -1, vbtextcompare)
for i = 0 to 3
if octetArray(i) >= octetIPLowArray(i) and octetArray(i) <= octetIPHighArray(i) then
compareIps = True
exit function
end if
next
end function
if compareIps(remote_addr, "3.0.0.0","3.255.255.255")=True then
response.end
end if
Please note that in case of US IP-traffic there are quite a few ranges to block (nearly 7.000).
As already commented, IPs can be spoofed so it's not a 100% safe method at all.
Related
I have a little problem, thanks for whatever help you might bring :)
my goal : i want to create a vba function that receives an address and returns the gps coordinates related to this address. To do so, i want to open my address in Openstreetmap (or Google Maps) in order to extract the page's URL which has the gps coordinated within it.
problem : my function only works way, it open the address in the navigator but it won't return the URL...
my code :
Option Explicit
Function AdresseToCoordonnesGPS(URL As String)
Dim navigateur As Object
Set navigateur = CreateObject("Shell.Application").ShellExecute("microsoft-edge:" & URL)
navigateur.Visible = True
Do While navigateur.busy And navigateur.ReadyState <> 4
DoEvents
Loop
pause (3)
Dim redirection As String
redirection = navigateur.locationUrl
redirection = Right(redirection, Len(redirection) - InStr(redirection, "#"))
redirection = Right(redirection, Len(redirection) - InStr(redirection, "/"))
AdresseToCoordonnesGPS = redirection
End Function
result : this function manages to open the link in the navigator (microsoft edge) it won't copy the page's URL, which i need in order to extract the GPS coordinates
here's what it return :
First I want to check via VBA, before I do some transactions in SAP GUI, if a connection is already open. I am not able to login a second time, so I need to stay in the same connection.
Secondly I want to open another session. The second problem has been solved, if I assume SAP GUI is already open. But I don't know it for sure. So I need to find a way to access the current SAPGUI and Application and Connection, if they exist. If not, the standard code of If Not IsObject(SAPGUI) Then… is fine. But how do I define these variables correctly to check, if they are „filled“ Objects or not?
Thanks for help!
Based on a script by S. Schnell you can use the follwing function to find a free session
Function findGuiSession(ByVal sapSID As String, Optional tCode As String) As SAPFEWSELib.GuiSession
' this will find a free session using the systemnam resp. SID
' and optional one can also supply a transaction to
Dim CollCon As SAPFEWSELib.GuiComponentCollection
Dim CollSes As SAPFEWSELib.GuiComponentCollection
Dim guiCon As SAPFEWSELib.GuiConnection
Dim guiSes As SAPFEWSELib.GuiSession
Dim guiSesInfo As SAPFEWSELib.GuiSessionInfo
Dim i As Long, j As Long
Dim SID As String, transaction As String
'On Error GoTo EH
Dim guiApplication As SAPFEWSELib.guiApplication
Set guiApplication = getGuiApplication
If guiApplication Is Nothing Then
Exit Function
End If
Set CollCon = guiApplication.Connections
If Not IsObject(CollCon) Then
Exit Function
End If
' Loop through all existing connections
For i = 0 To CollCon.Count() - 1
Set guiCon = guiApplication.Children(CLng(i))
If Not IsObject(guiCon) Then
Exit Function
End If
Set CollSes = guiCon.Sessions
If Not IsObject(CollSes) Then
Exit Function
End If
' Now loop through all existing sessions
For j = 0 To CollSes.Count() - 1
Set guiSes = guiCon.Children(CLng(j))
If Not IsObject(guiSes) Then
Exit Function
End If
If guiSes.Busy = vbFalse Then
Set guiSesInfo = guiSes.Info
If guiSesInfo.user = "" Or guiSesInfo.user = "SAPSYS" Then
' Logon Screen - cannot be used
Else
If IsObject(guiSesInfo) Then
SID = guiSesInfo.SystemName()
transaction = guiSesInfo.transaction()
' Take the first one - In case one could also use the transactionaction addtionally
If Len(tCode) = 0 Then
If SID = sapSID Then
Set findGuiSession = guiSes
'FindSession = True
Exit Function
End If
Else
If SID = sapSID And transaction = tCode Then
Set findGuiSession = guiSes
'FindSession = True
Exit Function
End If
End If
End If
End If
End If
Next
Next
Exit Function
'EH:
End Function
Function getGuiApplication() As SAPFEWSELib.guiApplication
On Error GoTo EH
Set getGuiApplication = GetObject("SAPGUI").GetScriptingEngine
EH:
End Function
For this code to run you need to add a reference to the SAP library, described here
The following piece of code uses the above function to connect to a system with the name P11, starts the transaction MB52 and downloads the result in a Excel file
Option Explicit
Sub getMB52_data()
Dim guiSes As SAPFEWSELib.GuiSession
Set guiSes = getGuiSession("P11")
If Not guiSes Is Nothing Then
With guiSes
.StartTransaction "MB52"
.FindById("wnd[0]/usr/ctxtMATNR-LOW").Text = "<MATNR_LOW<" ' replace with a material nr
.FindById("wnd[0]/usr/ctxtMATNR-HIGH").Text = "<MATNR_HIGH<" ' replace with a material nr
.FindById("wnd[0]/usr/ctxtWERKS-LOW").Text = "<WERKS>" ' replace wiht a plant
.FindById("wnd[0]/tbar[1]/btn[8]").Press
.FindById("wnd[0]/tbar[0]/okcd").Text = "&XXL"
.FindById("wnd[0]/tbar[0]/btn[0]").Press
.FindById("wnd[1]/tbar[0]/btn[0]").Press
.FindById("wnd[1]/usr/ctxtDY_PATH").Text = "<xlPath>" ' Pathname
.FindById("wnd[1]/usr/ctxtDY_FILENAME").Text = "<xlFile>" ' filename
.FindById("wnd[1]/tbar[0]/btn[11]").Press
End With
Else
MsgBox "No free SAP Session", vbOKOnly + vbInformation, "SAP Verbindung"
End If
End Sub
Function getGuiSession(sapSID As String, Optional tCode As String) As SAPFEWSELib.GuiSession
Dim guiApp As SAPFEWSELib.guiApplication
Set guiApp = getGuiApplication
If Not guiApp Is Nothing Then
Set getGuiSession = findGuiSession(sapSID, tCode)
End If
End Function
Additonal remarks: (hopefully answering some questions in the comments)
Gui Connection: A GuiConnection represents the connection between SAP GUI and an application server. Connections can be opened from SAP Logon or from GuiApplication’s openConnection and openConnectionByConnectionString
methods
So, in other words a gui connection is a kind of login to an SAP system. And usually you have more than one SAP system in your organization. If you follow the guidelines you have a DEV, QUAL and PROD for a given system environment. Each of this system is identifid by a SID
What is SID?
SID is a unique identification code for every R/3 installation (SAP system) consisting of a database server & several application servers. SID stands for SAP System Identification. SAPSID — a three-character code such as C11, PRD, E56, etc.)
An SID is unique within the organization. Usually SAP licence only allows a user to login to a productive system only once, i.e. you cannot use the same user on different computers and you cannot even login to a SAP system with the same user on the same computer twice.
Having said that: One might be tempted to use guiApplication.Children(0) instead of looping through all connections as done in findGuiSession. And this will work as long as you can make sure that you are only logged on to one SAP system and it is the right one. But in my experience this is often not the case.
The parameter SID in findGuiSession tells the function which system to look for. As written above SID is unique and therefore identfies the system you want to use.
Using tCode in findGuiSession is optional and just forces the user to have a session in place with a given tCode already started. I use this very seldom.
OpenConnection: If you open a connection with the function OpenConnection("<SYSTEM>") you can, of course, use the returned object in order to work with it. But this only does a logon to the system if you have a kind of single sign on in your organization in place. Otherwise you have to provide logon credentials. I do not use this because I do not want to take care of this. And it also can happen that a password change is requested during the logon and I sure do not want to script this.
Example code
Rem Open a connection in synchronous mode
Set Connection = Application.OpenConnection( "U9C [PUBLIC]", True)
Set Session = Connection.Children(0)
Rem Do something: Either fill out the login screen
Rem or in case of Single-Sign-On start a transaction.
Session.SendCommand( "/nbibs")
I have a VB.net application which needs to read and write Excel workbooks, using OLEDB and the MS Office Access Database driver. Over time, I have learned a vast amount here on StackOverflow which allowed me to get everything working the way it should be. Those topics covered everything from connectionstrings to the "magic" TypeGuessRows setting / 255 character limitation, now located in the registry. Over time, that issue by itself has morphed due to the evolutions by Microsoft over the years, so I won't reference those (hundreds? thousands?) of posts here. Suffice it to say that I was able to piece it all together and get it working.
For reference: my connectionstring looks like this:
"Provider=Microsoft.ACE.OLEDB.12.0;Data Source='#DBQ';Extended Properties='Excel 12.0 Xml;HDR=YES';"
where '#DBQ' is replaced at runtime by the appropriate pathname of the selected Excel workbook. Note that it does not contain TypeGuessRows (since that has moved to the registry), and IMEX=(whatever) has not effect either, so it does not appear. The result is that everything works quite well, AS LONG AS TYPEGUESSROWS is set to zero in the registry.
Using regedit to manually hunt down and set TypeGuessRows=0 in all occurrences (one of the things I learned about here on StackOverflow), this has worked and avoids the 255-char truncation perfectly.
The problem is that whenever there is a Windows update, it gets set back to the default value, 8. There is no warning or announcement of this; I only know about it when I start seeing the "truncated at 255 characters" symptom showing up again. So then I have to go back and use RegEdit again.
The obvious solution would be that the app does this setting on its own, but that seems to require manipulation of the Security features, which is something I'd prefer to avoid entirely as it seems to be more complex than I want to deal with presently.
So, I thought, "why not just scan the appropriate registry keys, and report if they are not zero", then issue a message to the user to get it sorted using regedit.
I wrote the following function, which looks at all of the various registry keys I have found which contain TypeGuessRows:
Public Function CheckRegistry() As Integer
Dim Val1 As Integer = 0, Val2 As Integer = 0
Dim KeysToCheck As String() = New String() {
"HKEY_LOCAL_MACHINE\SOFTWARE\WOW6432Node\Microsoft\Jet\4.0\Engines\Excel",
"HKEY_LOCAL_MACHINE\SOFTWARE\WOW6432Node\Microsoft\Jet\4.0\Engines\Lotus",
"HKEY_LOCAL_MACHINE\SOFTWARE\WOW6432Node\Microsoft\Office\14.0\Access Connectivity Engine\Engines\Excel",
"HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\ClickToRun\REGISTRY\MACHINE\Software\Wow6432Node\Microsoft\Office\16.0\Access Connectivity Engine\Engines\Excel"
}
'
' try two methods for checking the registry values.
'
' method 1 uses the My.Computer class
'
For Each Key As String In KeysToCheck
Dim aVal As Object = My.Computer.Registry.GetValue(Key, "TypeGuessRows", CType("BOGUS", Object))
If IsNothing(aVal) Then ' did we hit Nothing?
Continue For ' have to skip it
ElseIf aVal.Equals(CType("BOGUS", Object)) Then ' did we hit one not exist?
Val1 = -9999 ' set a crazy value
End If
Val1 += CInt(aVal) ' otherwise, get its value and add to total
Next
'
' method 2 uses the RegistryKey class
'
Dim aKey As Microsoft.Win32.RegistryKey
For Each Key As String In KeysToCheck
Dim LM As Microsoft.Win32.RegistryKey = Microsoft.Win32.Registry.LocalMachine ' point to HKLM
Key = Key.TrimStart("HKEY_LOCAL_MACHINE\".ToCharArray) ' peel off the start (a convenience)
aKey = LM.OpenSubKey(Key, Microsoft.Win32.RegistryKeyPermissionCheck.ReadSubTree) ' try to read the subkey
If IsNothing(aKey) Then Continue For ' did we hit Nothing? have to skip it
'If CInt(aKey.GetValue("TypeGuessRows", 0)) <> 0 Then aKey.SetValue("TypeGuessRows", 0)
Val2 += CInt(aKey.GetValue("TypeGuessRows", 0)) ' otherwise, get its value and add to total
Next
Return Val1 + Val2 ' return the sum of both methods
End Function
This works well enough, EXCEPT FOR THE LAST ONE, the one with "...ClickToRun..." in the key name.
No matter what, this ALWAYS returns as Nothing, so the attempt to check it fails. Even in the first method, where I specifically ask it to return a "BOGUS" object, it always returns as Nothing.
The problem is that it is THIS KEY which gets updated by Windows Update. Thus far I have never seen any of the other three get reset.
If I "walk the tree" of this key (i.e., try looking at "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office"), it works fine until I hit the ClickToRun branch, at which point it just returns Nothing.
So, I guess I have two questions:
Is there a way to read this key so that it does not return as Nothing?
Can someone provide a (hopefully not too messy / complex) guide to getting the Security settings correct to allow "ReadWriteSubTree" for the permission check? N.B. if I try that now, I get Security exception, telling me that the app does not have the appropriate permission. That's why the aKey.SetValue line is commented out.
Further info:
the machine is Win 10 Pro, 64-bit, with appropriate drivers installed. The app is set to "Enable ClickToRun security settings", and "full trust application". I have played with those settings and the appropriate entries in app.manifest, but thus far that only causes (much) other grief and difficulties elsewhere. That's why I'd prefer to not mess with it.
Any help would be really appreciated.
After some sleep, some more thought and in particular, some hints found [here]
Reading 64bit Registry from a 32bit application I managed to at least get the ability to read the registry keys.
The problem was that I was trying to "read" 64-bit registry keys from my 32-bit app.
Now I can do what I really wanted to do, which was to detect when the TypeGuessRows issue has cropped up again, and warn the user to do something about it.
Here is the modified code:
Public Function CheckRegistry() As Integer
Dim CheckVal As Integer = 0
Dim KeysToCheck As String() = New String() {
"SOFTWARE\WOW6432Node\Microsoft\Jet\4.0\Engines\Excel",
"SOFTWARE\WOW6432Node\Microsoft\Jet\4.0\Engines\Lotus",
"SOFTWARE\WOW6432Node\Microsoft\Office\14.0\Access Connectivity Engine\Engines\Excel",
"SOFTWARE\Microsoft\Office\ClickToRun\REGISTRY\MACHINE\Software\Wow6432Node\Microsoft\Office\16.0\Access Connectivity Engine\Engines\Excel"
}
Dim LMachine As Microsoft.Win32.RegistryKey =
Microsoft.Win32.RegistryKey.OpenBaseKey(Microsoft.Win32.RegistryHive.LocalMachine,
Microsoft.Win32.RegistryView.Registry64)
Dim LKey As Microsoft.Win32.RegistryKey
For Each Key As String In KeysToCheck
Try
LKey = LMachine.OpenSubKey(Key, Microsoft.Win32.RegistryKeyPermissionCheck.ReadSubTree)
CheckVal += CInt(LKey.GetValue("TypeGuessRows", 0))
Catch ex As Exception
LMachine.Close()
Return -9999
End Try
Next
LMachine.Close()
Return CheckVal
End Function
In testing this out, it can successfully check all four of the keys shown. The try-catch is never fired, but I left it there for safety anyway.
I hope that someone else might find this useful.
First of all tank you for all help here! nice place to be and learn a lot!
My Problem: I want to return Geo coordinates from an address. Like here: https://www.myengineeringworld.net/2014/06/geocoding-using-vba-google-api.html
I created an API Key and this code is working fine! But we have a Firewall and the Firewall is blocking Excel communication to the google maps server on the "request.send" point (and i couldn't find an IP Range or something that you can put on the whitelist), is there a chance to get the XML code by your browser? Because i can use the link from "Request.Open "GET" and i see the XML content in the Internet Explorer.
Is there any other way than request.send
Thank you guys!
Code:
Function GetCoordinates(Address As String) As String
'-----------------------------------------------------------------------------------------------------
'This function returns the latitude and longitude of a given address using the Google Geocoding API.
'The function uses the "simplest" form of Google Geocoding API (sending only the address parameter),
'so, optional parameters such as bounds, language, region and components are NOT used.
'In case of multiple results (for example two cities sharing the same name), the function
'returns the FIRST OCCURRENCE, so be careful in the input address (tip: use the city name and the
'postal code if they are available).
'NOTE: As Google points out, the use of the Google Geocoding API is subject to a limit of 40,000
'requests per month, so be careful not to exceed this limit. For more info check:
'https://cloud.google.com/maps-platform/pricing/sheet
'In order to use this function you must enable the XML, v3.0 library from VBA editor:
'Go to Tools -> References -> check the Microsoft XML, v3.0.
'If you don't have the v3.0 use any other version of it (e.g. v6.0).
'2018 Update: In order to use this function you will now need a valid API key.
'Check the next link that guides you on how to acquire a free API key:
'https://www.myengineeringworld.net/2018/02/how-to-get-free-google-api-key.html
'2018 Update 2 (July): The EncodeURL function was added to avoid problems with special characters.
'This is a common problem with addresses that are from Greece, Serbia, Germany and other countries.
'Written By: Christos Samaras
'Date: 12/06/2014
'Last Updated: 09/08/2018
'E-mail: xristos.samaras#gmail.com
'Site: https://www.myengineeringworld.net
'-----------------------------------------------------------------------------------------------------
'Declaring the necessary variables.
'The first 2 variables using 30 at the end, corresponding to the "Microsoft XML, v3.0" library
'in VBA (msxml3.dll). If you use any other version of it (e.g. v6.0), then declare these variables
'as XMLHTTP60 and DOMDocument60 respectively.
Dim ApiKey As String
Dim Request As New XMLHTTP30
Dim Results As New DOMDocument30
Dim StatusNode As IXMLDOMNode
Dim LatitudeNode As IXMLDOMNode
Dim LongitudeNode As IXMLDOMNode
'Set your API key in this variable. Check this link for more info:
'https://www.myengineeringworld.net/2018/02/how-to-get-free-google-api-key.html
ApiKey = "Your API Key goes here!"
'Check that an API key has been provided.
If ApiKey = vbNullString Or ApiKey = "Your API Key goes here!" Then
GetCoordinates = "Invalid API Key"
Exit Function
End If
'Generic error handling.
On Error GoTo errorHandler
'Create the request based on Google Geocoding API. Parameters (from Google page):
'- Address: The address that you want to geocode.
'Note: The EncodeURL function was added to allow users from Greece, Poland, Germany, France and other countries
'geocode address from their home countries without a problem. The particular function (EncodeURL),
'returns a URL-encoded string without the special characters.
Request.Open "GET", "https://maps.googleapis.com/maps/api/geocode/xml?" _
& "&address=" & Application.EncodeURL(Address) & "&key=" & ApiKey, False
'Send the request to the Google server.
Request.send
'Read the results from the request.
Results.LoadXML Request.responseText
'Get the status node value.
Set StatusNode = Results.SelectSingleNode("//status")
'Based on the status node result, proceed accordingly.
Select Case UCase(StatusNode.Text)
Case "OK" 'The API request was successful. At least one geocode was returned.
'Get the latitude and longitude node values of the first geocode.
Set LatitudeNode = Results.SelectSingleNode("//result/geometry/location/lat")
Set LongitudeNode = Results.SelectSingleNode("//result/geometry/location/lng")
'Return the coordinates as a string (latitude, longitude).
GetCoordinates = LatitudeNode.Text & ", " & LongitudeNode.Text
Case "ZERO_RESULTS" 'The geocode was successful but returned no results.
GetCoordinates = "The address probably not exists"
Case "OVER_QUERY_LIMIT" 'The requestor has exceeded the limit of 2500 request/day.
GetCoordinates = "Requestor has exceeded the server limit"
Case "REQUEST_DENIED" 'The API did not complete the request.
GetCoordinates = "Server denied the request"
Case "INVALID_REQUEST" 'The API request is empty or is malformed.
GetCoordinates = "Request was empty or malformed"
Case "UNKNOWN_ERROR" 'Indicates that the request could not be processed due to a server error.
GetCoordinates = "Unknown error"
Case Else 'Just in case...
GetCoordinates = "Error"
End Select
End Function '
You can try to detect the proxy settings and add these to the XMLHTTP request.
See this link for a good starting point (too much code to paste here): http://www.tech-archive.net/Archive/VB/microsoft.public.vb.winapi.networks/2004-11/0005.html
I have an app in classic asp and want to rewrite URLs.
From: go.asp?t=5&group=XXXXXX&sub=YYYYY to: cat/XXXXXXXXXXXXX/YYYYYYYYYY
and from: go.asp?t=15&number=XXXXXXXX to lets say: S/XXXXXXXX
and so on, I will have more rules just with different T variable values.
How can I write rewrite rules and proper redirect based on specific T value?
Seems like a viable question to me. In Classic ASP, for a get, the querystring values are available in Request.QueryString("varname"). So you could do
dim t, sResult, oRequest
set oRequest = Request.QueryString ' convenience assignment
t = oRequest("t")
t = cLng(t) ' force t from string into a number
select case t
case 1
dim sGroup, sSub ' sub is a keyword to VBScript
sGroup=oRequest("group")
sSub=oRequest("sub")
sResult = "cat/" & sGroup & "/" & sSub
case 15
dim sNumber
sNumber=oRequest("number")
sResult = "S/" & sNumber
end select
response.redirect sResult
The code is untested but should lead you in the right direction. You can extend the cases and the URL param harvesting as required by your use case.
If it was me and there were a large number of cases I would probably set up some kind of metadata to describe what to harvest per value of 't' then have one function to handle the job based on that.
There 'are' more sophisticated IIS-level URL redirection features but they introduce other dependencies. If all you need to do is modify the incoming URL then this is a cheap and cheerful way forward.