Mini Kabibi Habibi
Imports Microsoft.VisualBasic
Imports System
Imports System.Collections.Generic
Imports System.IO
Imports System.Reflection
Imports System.Security.Cryptography
Imports System.Text
Imports System.Web
Imports System.Diagnostics
Imports System.Runtime.InteropServices
Imports Microsoft.Win32
Namespace DemoLauncher.Web
Public Class DemosMainHandler
Implements IHttpHandler
Public Sub ProcessRequest(ByVal context As HttpContext) Implements IHttpHandler.ProcessRequest
Dim request As String = HttpUtility.UrlDecode(context.Request.QueryString.ToString())
Dim data() As Byte = GetData(request)
If data Is Nothing Then
data = New Byte() { }
End If
Dim hash As String = GetHash(data)
Dim ifNoneMatch As String = context.Request.Headers("If-None-Match")
If ifNoneMatch = hash Then
context.Response.StatusCode = 304
context.Response.StatusDescription = "Not Modified"
Return
End If
context.Response.ContentType = "application/octet-stream"
context.Response.BinaryWrite(data)
context.Response.Cache.SetCacheability(HttpCacheability.Public)
context.Response.Cache.SetRevalidation(HttpCacheRevalidation.AllCaches)
context.Response.Cache.SetETag(hash)
End Sub
Public ReadOnly Property IsReusable() As Boolean Implements IHttpHandler.IsReusable
Get
Return True
End Get
End Property
Private Shared Function GetHash(ByVal data() As Byte) As String
Using sha1 As New SHA1Managed()
Dim hash() As Byte = sha1.ComputeHash(data)
Dim formatted As New StringBuilder(2 * hash.Length)
For Each b As Byte In hash
formatted.AppendFormat("{0:X2}", b)
Next b
Return formatted.ToString()
End Using
End Function
Private Function GetData(ByVal request As String) As Byte()
Try
Dim parts() As String = request.Split(":"c)
If parts.Length = 0 Then
Return Nothing
End If
Select Case parts(0)
Case "lp"
Return GetLicensedProducts(parts)
Case "source"
Return GetSourceData(parts)
Case "bin"
Return GetBinData(parts)
Case "run"
Return RunApplication(parts)
Case "de" 'DEMO_REMOVE
Return DoEvent(parts)
End Select
Catch
End Try
Return Nothing
End Function
Private Shared Function GetSourceData(ByVal parts() As String) As Byte()
If parts.Length <> 4 Then
Return Nothing
End If
Dim filePath As String = FindSourceFile(HttpContext.Current, parts(1), parts(2), parts(3))
Return ReadFile(filePath)
End Function
Private Shared Function GetBinData(ByVal parts() As String) As Byte()
If parts.Length <> 3 Then
Return Nothing
End If
Dim demoName As String = parts(1)
Dim partName As String = parts(2)
If String.IsNullOrEmpty(partName) Then
partName = demoName & ".xap"
Else
partName = partName & ".zip"
End If
Dim filePath As String = FindBinFile(HttpContext.Current, partName)
Return ReadFile(filePath)
End Function
Private Shared Function ReadFile(ByVal path As String) As Byte()
Try
If String.IsNullOrEmpty(path) Then
Return Nothing
End If
Using stream As New FileStream(path, FileMode.Open, FileAccess.Read)
Dim data(CInt(Fix(stream.Length)) - 1) As Byte
stream.Read(data, 0, data.Length)
Return data
End Using
Catch
Return Nothing
End Try
End Function
Private Shared Function GetDirectories(ByVal baseDir As String, ByVal pathPattern As String) As String()
Dim pathParts() As String = pathPattern.Split(Path.DirectorySeparatorChar, Path.AltDirectorySeparatorChar)
Dim resolvedPaths As New List(Of String)()
resolvedPaths.Add(baseDir)
For Each pathPart As String In pathParts
Dim nextResolvedPaths As New List(Of String)()
For Each resolvedPath As String In resolvedPaths
If pathPart = ".." Then
nextResolvedPaths.Add(Path.GetFullPath(Path.Combine(resolvedPath, "..")))
Else
nextResolvedPaths.AddRange(Directory.GetDirectories(resolvedPath, pathPart, SearchOption.TopDirectoryOnly))
End If
Next resolvedPath
resolvedPaths = nextResolvedPaths
Next pathPart
Return resolvedPaths.ToArray()
End Function
Private Shared Function FindBinFile(ByVal context As HttpContext, ByVal partName As String) As String
Dim appPath As String = context.Server.MapPath("~")
If appPath Is Nothing Then
Return Nothing
End If
Dim baseDir As String = Path.GetFullPath(appPath)
For Each binPath As String In New String() { "ClientBin", "..\..\XtraReports\CS\ReportService\ClientBin", "..\..\*\*.Web\ClientBin", "..\..\..\Demos.Win\ReportsDemos\CS\ReportSilverlightDemo\ReportService\ClientBin" }
For Each dir As String In GetDirectories(baseDir, binPath)
Dim files() As String = Directory.GetFiles(dir, partName, SearchOption.TopDirectoryOnly)
If files.Length <> 0 Then
Return files(0)
End If
Next dir
Next binPath
Return Nothing
End Function
Private Shared Function FindSourceFile(ByVal context As HttpContext, ByVal directoryName As String, ByVal demoName As String, ByVal fileName As String) As String
Dim s As String = FindSourceFileCore(context, directoryName, demoName, fileName)
If s Is Nothing Then
s = FindSourceFileCore(context, "XtraReports\" & directoryName, demoName, fileName)
End If
Return s
End Function
Private Shared Function FindSourceFileCore(ByVal context As HttpContext, ByVal directoryName As String, ByVal demoName As String, ByVal fileName As String) As String
Try
Dim baseDir As String = FindDirectory(context, directoryName)
Dim demoDirs() As String = Directory.GetDirectories(baseDir, demoName & "*", SearchOption.TopDirectoryOnly)
If demoDirs.Length = 0 Then
Return Nothing
End If
Dim files() As String = Directory.GetFiles(demoDirs(0), fileName, SearchOption.AllDirectories)
If files.Length = 0 Then
Return Nothing
End If
Return files(0)
Catch
Return Nothing
End Try
End Function
Private Shared Function FindFile(ByVal context As HttpContext, ByVal fileName As String, ByVal directoryName As String) As String
Dim appPath As String = context.Server.MapPath("~")
If appPath Is Nothing Then
Return Nothing
End If
Dim dirName As String = Path.GetFullPath(appPath)
For n As Integer = 0 To 8
Dim path As String = dirName & "\" & directoryName & "\" & fileName
Try
If File.Exists(path) Then
Return path
End If
Catch
End Try
dirName &= "\.."
Next n
Throw New FileNotFoundException(fileName & " not found")
End Function
Private Shared Function FindDirectory(ByVal context As HttpContext, ByVal directoryName As String) As String
Dim appPath As String = context.Server.MapPath("~")
If appPath Is Nothing Then
Return Nothing
End If
Dim dirName As String = Path.GetFullPath(appPath)
For n As Integer = 0 To 8
Dim path As String = dirName & "\" & directoryName
Try
If Directory.Exists(path) Then
Return path
End If
Catch
End Try
dirName &= "\.."
Next n
Throw New DirectoryNotFoundException(directoryName & " not found")
End Function
Private Shared Function GetLicensedProducts(ByVal parts() As String) As Byte()
Dim userData As DevExpress.Internal.UserData = DevExpress.Utils.About.Utility.GetInfo() 'DEMO_REMOVE
If userData Is Nothing Then 'DEMO_REMOVE
Return Nothing
End If
Dim licensedProducts As Long = Long.MaxValue
licensedProducts = CLng(Fix(userData.GetType().GetProperty("LicensedProducts", BindingFlags.Instance Or BindingFlags.NonPublic).GetValue(userData, Nothing))) 'DEMO_REMOVE
Dim data As New List(Of Byte)()
Do While licensedProducts > 0
data.Add(CByte(licensedProducts And &HFF))
licensedProducts = licensedProducts >> 8
Loop
Return data.ToArray()
End Function
Private Shared Function RunApplication(ByVal parts() As String) As Byte()
If parts.Length <> 2 Then
Return Nothing
End If
Dim file As String = DevExpress.DemoData.Helpers.StartApplicationHelper.UrlHelper.Unscreen(parts(1))
Dim [error] As String = DevExpress.DemoData.Helpers.StartApplicationHelper.Start(file, Nothing, False)
Return If(String.IsNullOrEmpty([error]), Nothing, Encoding.UTF8.GetBytes([error]))
End Function
Private Shared Function DoEvent(ByVal parts() As String) As Byte() 'DEMO_REMOVE
If parts.Length <> 4 Then 'DEMO_REMOVE
Return Nothing
End If
Dim kind As Byte = Byte.Parse(parts(1)) 'DEMO_REMOVE
Dim platform As Byte = Byte.Parse(parts(2)) 'DEMO_REMOVE
Dim action As String = DevExpress.DemoData.Helpers.StartApplicationHelper.UrlHelper.Unscreen(parts(3)) 'DEMO_REMOVE
DevExpress.Utils.About.UAlgo.Default.DoEvent(kind, platform, action) 'DEMO_REMOVE
Return Nothing 'DEMO_REMOVE
End Function 'DEMO_REMOVE
End Class
End Namespace