Leaked source code of windows server 2003
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 
 
 

570 lines
14 KiB

<% '==================================================
' Microsoft Server Appliance
'
' Sets language based on browser settings
'
' Copyright (c) Microsoft Corporation. All rights reserved.
'================================================== %>
<%
Dim objLocalMgr
Dim iBrowserLangID
Dim arrLangDisplayNames,arrLangISONames, arrLangCharSets
Dim arrLangCodePages, arrLangIDs
Const strLANGIDName = "LANGID"
Const ConstDword = 1
on error resume next
set objLocalMgr = Server.CreateObject("ServerAppliance.LocalizationManager")
If Err.number <> 0 Then
If ( Err.number = &H800401F3 ) Then
Response.Write("Unable to locate a software component on the Server Appliance. ")
Response.Write("The Server Appliance core software components do not appear to be installed correctly.")
Else
Response.Write("Server.CreateObject(ServerAppliance.LocalizationManager) failed with error code: " + CStr(Hex(Err.Number)) + " " + Err.Description)
End If
Call SA_TraceOut("SH_TASK", "Server.CreateObject(ServerAppliance.LocalizationManager) failed with error code: " + CStr(Hex(Err.Number)) )
Response.End
End If
'
' set the locale EVERYTIME
' This can cause an error if the LCID is not available, in that case we don't touch the locale
Call SetLCID()
on error goto 0
If Not objLocalMgr.fAutoConfigDone Then
Dim strBrowserLang
Dim iCurLang, iCurLangID
on error resume next
iCurLang = objLocalMgr.GetLanguages(arrLangDisplayNames, arrLangISONames, arrLangCharSets, arrLangCodePages, arrLangIDs)
iCurLangID = arrLangIDs(iCurLang)
'Err.Clear 'Here getting -2147467259 Error
strBrowserLang = getBrowserLanguage()
iBrowserLangID = isSupportedLanguage(strBrowserLang)
If iBrowserLangID <> 0 Then
'Browser Language and Current Language "LANGID" might be diiferent..
Call ExecuteTask1(Hex(iBrowserLangID), Hex(iCurLangID))
End if
If SA_IsDebugEnabled() Then
on error goto 0
End If
End if
'
' set the code page EVERYTIME
'
'Session.CodePage = objLocalMgr.CurrentCodePage
' Hard coded for Unicode (UTF-8) codepage
Session.CodePage = 65001
Set objLocalMgr = Nothing
'----------------------------------------------------------------------------
'
' Function : getBroswerLanguage
'
' Synopsis : Serves in getting Browser Default Language ID
'
' Arguments: None
'
' Returns : ISO 693 name
'
'----------------------------------------------------------------------------
Function getBrowserLanguage
Err.Clear
Dim strAcceptLanguage
Dim iPos
strAcceptLanguage = Request.ServerVariables("HTTP_ACCEPT_LANGUAGE")
iPos = InStr(1, strAcceptLanguage, ",")
If iPos > 0 Then
strAcceptLanguage = Left(strAcceptLanguage, iPos - 1)
End If
getBrowserLanguage = LCase(strAcceptLanguage)
End Function
'----------------------------------------------------------------------------
'
' Function : isSupportedLanguage
'
' Synopsis : checks whether the given language is supported by framework,
' if yes returns the lang id else returns 0
'
' Arguments: strBrowserLang(IN) - ISO Name of Language
'
' Returns : Language ID
'
'----------------------------------------------------------------------------
Function isSupportedLanguage(strBrowserLang)
Err.Clear
Dim name
Dim iIndex
Dim ISOName
Dim iLangID
iIndex=0
iLangID = 0
'
' Chinese Hong Kong or Macau selects Chinese traditional
'
If ("zh-hk" = strBrowserLang) Or ("zh-mo" = strBrowserLang) Then
strBrowserLang = "zh-tw"
End If
for each ISOName in arrLangISONames
If ISOName = strBrowserLang Then
iLangID = arrLangIDs(iIndex)
Exit for
End if
iIndex = iIndex + 1
next
' If we did not get a match for the full name try the short name
If ((0 = iLangID) AND (Len(strBrowserLang) > 2)) Then
iIndex=0
strBrowserLang = Left(strBrowserLang, 2)
for each ISOName in arrLangISONames
If ISOName = strBrowserLang Then
iLangID = arrLangIDs(iIndex)
Exit for
End if
iIndex = iIndex + 1
next
End If
isSupportedLanguage = iLangID
End Function
'----------------------------------------------------------------------------
'
' Function : ExecuteTask1
'
' Synopsis : Executes the ChangeLanguage task
'
' Arguments: strLangID(IN) - The LANGID as a string
' strCurrentLangID(IN) - The current LANGID as a string
'
' Returns : true/false for success/failure
'
'----------------------------------------------------------------------------
Function ExecuteTask1(ByVal strLangID, ByVal strCurrentLangID)
Err.Clear
on error resume next
Dim objTaskContext,objAS,rc
Dim objSL
Dim sReturnURL
Dim sURL
Const strMethodName = "ChangeLanguage"
Set objTaskContext = CreateObject("Taskctx.TaskContext")
If Err.Number <> 0 Then
ExecuteTask1 = FALSE
Exit Function
End If
Set objAS = CreateObject("Appsrvcs.ApplianceServices")
If Err.Number <> 0 Then
ExecuteTask1 = FALSE
Exit Function
End If
objTaskContext.SetParameter "Method Name", strMethodName
objTaskContext.SetParameter "LanguageID", strLANGID
objTaskContext.SetParameter "AutoConfig", "y"
If Err.Number <> 0 Then
ExecuteTask1 = FALSE
Exit Function
End If
objAS.Initialize()
If Err.Number <> 0 Then
ExecuteTask1 = FALSE
Exit Function
End If
rc = objAS.ExecuteTask("ChangeLanguage", objTaskContext)
If Err.Number <> 0 Then
ExecuteTask1 = FALSE
Exit Function
End If
'objAS.Shutdown
'If Err.Number <> 0 Then
' If Err.Number <> 438 Then 'error 438 shutdown is not supported..
' ExecuteTask1 = FALSE
' Exit Function
' End if
'End If
Err.Clear
Set objTaskContext = Nothing
If (strLangID <> strCurrentLangID) Then
Set objSL = Server.CreateObject("SetSystemLocale.SetSystemLocale")
If Err.Number <> 0 Then
'SA_TraceOut "autoconfiglang.asp", "Create SetSystemLocale.SetSystemLocale failed: " + CStr(Hex(Err.Number))
ExecuteTask1 = FALSE
objAS.Shutdown
Set objAS = Nothing
Exit Function
End If
objSL.SetLocale strLangID
If ( Err.Number <> 0 ) Then
'SA_TraceOut "autoconfiglang.asp", "objSL.SetLocale failed" + CStr(Hex(Err.Number))
ExecuteTask1 = FALSE
objAS.Shutdown
Set objAS = Nothing
Exit Function
End If
Set objSL = Nothing
Call RaiseLangChangeAlert(objAS)
End If
objAS.Shutdown
Set objAS = Nothing
ExecuteTask1 = TRUE
End Function
Private Function RaiseLangChangeAlert(ByRef oAppServices)
Err.Clear
on error resume next
Const SA_ALERT_CLASS = "Microsoft_SA_Resource"
Const SA_ALERT_DURATION_ETERNAL = 2147483647
Const SA_ALERT_TYPE_WARNING = 0
Const SA_ALERT_TYPE_FAILURE = 1
Const SA_ALERT_TYPE_INFORMATION = 2
Const SA_ALERT_NORMAL = 0
Const SA_ALERT_SINGLETON = 1
Const AUTOLANGCONFIG_LOG = "AutoLangConfig"
Const AUTOLANGCONFIG_ALERT_RestartRequired = 1
Dim rawData
Dim nullRepStrings
'
' Raise Alert
'
Call oAppServices.RaiseAlertEx(SA_ALERT_TYPE_WARNING, _
AUTOLANGCONFIG_ALERT_RestartRequired, _
AUTOLANGCONFIG_LOG, _
SA_ALERT_CLASS, _
SA_ALERT_DURATION_ETERNAL, _
nullRepStrings, _
rawData, _
SA_ALERT_SINGLETON)
End Function
%>
<SCRIPT Runat=Server Language=VBScript>
Sub SetLCID()
Dim strLCID
Select Case getBrowserLanguage
Case "af"
strLCID = 1078 ' Afrikaans
Case "sq"
strLCID = 1052 ' Albanian
Case "ar-sa"
strLCID = 1025 ' Arabic(Saudi Arabia)
Case "ar-iq"
strLCID = 2049 ' Arabic(Iraq)
Case "ar-eg"
strLCID = 3073 ' Arabic(Egypt)
Case "ar-ly"
strLCID = 4097 ' Arabic(Libya)
Case "ar-dz"
strLCID = 5121 ' Arabic(Algeria)
Case "ar-ma"
strLCID = 6145 ' Arabic(Morocco)
Case "ar-tn"
strLCID = 7169 ' Arabic(Tunisia)
Case "ar-om"
strLCID = 8193 ' Arabic(Oman)
Case "ar-ye"
strLCID = 9217 ' Arabic(Yemen)
Case "ar-sy"
strLCID = 10241 ' Arabic(Syria)
Case "ar-jo"
strLCID = 11265 ' Arabic(Jordan)
Case "ar-lb"
strLCID = 12289 ' Arabic(Lebanon)
Case "ar-kw"
strLCID = 13313 ' Arabic(Kuwait)
Case "ar-ae"
strLCID = 14337 ' Arabic(U.A.E.)
Case "ar-bh"
strLCID = 15361 ' Arabic(Bahrain)
Case "ar-qa"
strLCID = 16385 ' Arabic(Qatar)
Case "eu"
strLCID = 1069 ' Basque
Case "bg"
strLCID = 1026 ' Bulgarian
Case "be"
strLCID = 1059 ' Belarusian
Case "ca"
strLCID = 1027 ' Catalan
Case "zh-tw"
strLCID = 1028 ' Chinese(Taiwan)
Case "zh-cn"
strLCID = 2052 ' Chinese(PRC)
Case "zh-hk"
strLCID = 3076 ' Chinese(Hong Kong)
Case "zh-sg"
strLCID = 4100 ' Chinese(Singapore)
Case "hr"
strLCID = 1050 ' Croatian
Case "cs"
strLCID = 1029 ' Czech
Case "da"
strLCID = 1030 ' Danish
Case "n"
strLCID = 1043 ' Dutch(Standard)
Case "nl-be"
strLCID = 2067 ' Dutch(Belgian)
Case "en"
strLCID = 1033 ' English
Case "en-us"
strLCID = 1033 ' English(United States)
Case "en-gb"
strLCID = 2057 ' English(British)
Case "en-au"
strLCID = 3081 ' English(Australian)
Case "en-ca"
strLCID = 4105 ' English(Canadian)
Case "en-nz"
strLCID = 5129 ' English(New Zealand)
Case "en-ie"
strLCID = 6153 ' English(Ireland)
Case "en-za"
strLCID = 7177 ' English(South Africa)
Case "en-jm"
strLCID = 8201 ' English(Jamaica)
Case "en"
strLCID = 9225 ' English(Caribbean)
Case "en-bz"
strLCID = 10249 ' English(Belize)
Case "en-tt"
strLCID = 11273 ' English(Trinidad)
Case "et"
strLCID = 1061 ' Estonian
Case "fo"
strLCID = 1080 ' Faeroese
Case "fa"
strLCID = 1065 ' Farsi
Case "fi"
strLCID = 1035 ' Finnish
Case "fr"
strLCID = 1036 ' French(Standard)
Case "fr-be"
strLCID = 2060 ' French(Belgian)
Case "fr-ca"
strLCID = 3084 ' French(Canadian)
Case "fr-ch"
strLCID = 4108 ' French(Swiss)
Case "fr-lu"
strLCID = 5132 ' French(Luxembourg)
Case "gd"
strLCID = 1084 ' Gaelic(Scots)
Case "gd-ie"
strLCID = 2108 ' Gaelic(Irish)
Case "de"
strLCID = 1031 ' German(Standard)
Case "de-ch"
strLCID = 2055 ' German(Swiss)
Case "de-at"
strLCID = 3079 ' German(Austrian)
Case "de-lu"
strLCID = 4103 ' German(Luxembourg)
Case "de-li"
strLCID = 5127 ' German(Liechtenstein)
Case "e"
strLCID = 1032 ' Greek
Case "he"
strLCID = 1037 ' Hebrew
Case "hi"
strLCID = 1081 ' Hindi
Case "hu"
strLCID = 1038 ' Hungarian
Case "is"
strLCID = 1039 ' Icelandic
Case "in"
strLCID = 1057 ' Indonesian
Case "it"
strLCID = 1040 ' Italian(Standard)
Case "it-ch"
strLCID = 2064 ' Italian(Swiss)
Case "ja"
strLCID = 1041 ' Japanese
Case "ko"
strLCID = 1042 ' Korean
Case "ko"
strLCID = 2066 ' Korean(Johab)
Case "lv"
strLCID = 1062 ' Latvian
Case "lt"
strLCID = 1063 ' Lithuanian
Case "mk"
strLCID = 1071 ' Macedonian
Case "ms"
strLCID = 1086 ' Malaysian
Case "mt"
strLCID = 1082 ' Maltese
Case "no"
strLCID = 1044 ' Norwegian(Bokmal)
Case "no"
strLCID = 2068 ' Norwegian(Nynorsk)
Case "p"
strLCID = 1045 ' Polish
Case "pt-br"
strLCID = 1046 ' Portuguese(Brazilian)
Case "pt"
strLCID = 2070 ' Portuguese(Standard)
Case "rm"
strLCID = 1047 ' Rhaeto-Romanic
Case "ro"
strLCID = 1048 ' Romanian
Case "ro-mo"
strLCID = 2072 ' Romanian(Moldavia)
Case "ru"
strLCID = 1049 ' Russian
Case "ru-mo"
strLCID = 2073 ' Russian(Moldavia)
Case "sz"
strLCID = 1083 ' Sami(Lappish)
Case "sr"
strLCID = 3098 ' Serbian(Cyrillic)
Case "sr"
strLCID = 2074 ' Serbian(Latin)
Case "sk"
strLCID = 1051 ' Slovak
Case "s"
strLCID = 1060 ' Slovenian
Case "sb"
strLCID = 1070 ' Sorbian
Case "es"
strLCID = 1034 ' Spanish(Spain - Traditional Sort)
Case "es-mx"
strLCID = 2058 ' Spanish(Mexican)
Case "es"
strLCID = 3082 ' Spanish(Spain - Modern Sort)
Case "es-gt"
strLCID = 4106 ' Spanish(Guatemala)
Case "es-cr"
strLCID = 5130 ' Spanish(Costa Rica)
Case "es-pa"
strLCID = 6154 ' Spanish(Panama)
Case "es-do"
strLCID = 7178 ' Spanish(Dominican Republic)
Case "es-ve"
strLCID = 8202 ' Spanish(Venezuela)
Case "es-co"
strLCID = 9226 ' Spanish(Colombia)
Case "es-pe"
strLCID = 10250 ' Spanish(Peru)
Case "es-ar"
strLCID = 11274 ' Spanish(Argentina)
Case "es-ec"
strLCID = 12298 ' Spanish(Ecuador)
Case "es-c"
strLCID = 13322 ' Spanish(Chile)
Case "es-uy"
strLCID = 14346 ' Spanish(Uruguay)
Case "es-py"
strLCID = 15370 ' Spanish(Paraguay)
Case "es-bo"
strLCID = 16394 ' Spanish(Bolivia)
Case "es-sv"
strLCID = 17418 ' Spanish(El Salvador)
Case "es-hn"
strLCID = 18442 ' Spanish(Honduras)
Case "es-ni"
strLCID = 19466 ' Spanish(Nicaragua)
Case "es-pr"
strLCID = 20490 ' Spanish(Puerto Rico)
Case "sx"
strLCID = 1072 ' Sutu
Case "sv"
strLCID = 1053 ' Swedish
Case "sv-fi"
strLCID = 2077 ' Swedish(Finland)
Case "th"
strLCID = 1054 ' Thai
Case "ts"
strLCID = 1073 ' Tsonga
Case "tn"
strLCID = 1074 ' Tswana
Case "tr"
strLCID = 1055 ' Turkish
Case "uk"
strLCID = 1058 ' Ukrainian
Case "ur"
strLCID = 1056 ' Urdu
Case "ve"
strLCID = 1075 ' Venda
Case "vi"
strLCID = 1066 ' Vietnamese
Case "xh"
strLCID = 1076 ' Xhosa
Case "ji"
strLCID = 1085 ' Yiddish
Case "zu"
strLCID = 1077 ' Zulu
Case Else
strLCID = 2048 ' default
End Select
Session.LCID = strLCID
End Sub
</SCRIPT>