drupal hit counter
Jerry Huang | Old blog posts

Jerry Huang apps and developing apps

PDF to Tiff

18. July 2010 22:33 by Jerry in Old blog posts

I don’t know why, it seems to be hard to find something to convert PDF to Tiff over the web. Maybe TIFF is not that popular than other formats. Few months ago, I had a task at work to find a new way to generate tiff files out of crystal report. Previously we have a batch job that print the crystal report to a virtual printer to produce a tiff file. It was working fine, but from now and then the job hit an IO error couple times in a month. I was pissed off by being called at night (the job was running overnight). So I decided to revamp this piece of sxxx process.

After some searching, I realized that I need to solve 2 problems:

  • PDF to TIFF by using 3rd party component. I chose Ghostscript API, because it’s free and simple (one dll).
    The only issue of Ghostscript API (or other components) in this case is that, if the PDF has multiple pages, it produces multiple tiff files which that each tiff representing one page in the PDF. So it brings us to the next step;
  • Group all single page tiff files into one multiple pages TIFF

The source code provide below is running quite stable as batch job for a few months.

References

Ghostscript: http://www.ghostscript.com/ you need to put the gsdll32.dll in the same folder of your dll/exe

for step 2, the related source code was convert from C# in this article:
http://www.codeproject.com/KB/GDI-plus/SaveMultipageTiff.aspx
However, the ConvertToBitonal function has a bug. You need to dispose the original bitmap object (original.Dispose();) before returning destination.

Usage

ConvertFile("c:\2.tiff", "C:\temp\pdf\PWBSample.pdf", "c:\temp\tiff", "-IC:\Program Files\gs\gs8.70\lib;C:\Program Files\gs\fonts;C:/Windows/fonts")
 

Source Code

 

' Copyright (c) 2002 Dan Mount and Ghostgum Software Pty Ltd
'
' Permission is hereby granted, free of charge, to any person obtaining
' a copy of this software and associated documentation files (the
' "Software"), to deal in the Software without restriction, including
' without limitation the rights to use, copy, modify, merge, publish,
' distribute, sublicense, and/or sell copies of the Software, and to
' permit persons to whom the Software is furnished to do so, subject to
' the following conditions:
'
' The above copyright notice and this permission notice shall be
' included in all copies or substantial portions of the Software.
'
' THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
' EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
' MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
' NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
' BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
' ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
' CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
' SOFTWARE.


' This is an example of how to call the Ghostscript DLL from
' Visual Basic.NET. There are two examples, one converts
' colorcir.ps to PDF, the other is like command line Ghostscript.
' The display device is not supported.
'
' This code is not compatible with VB6. There is another
' example which does work with VB6. Differences include:
' 1. VB.NET uses GCHandle to get pointer
' VB6 uses StrPtr/VarPtr
' 2. VB.NET Integer is 32bits, Long is 64bits
' VB6 Integer is 16bits, Long is 32bits
' 3. VB.NET uses IntPtr for pointers
' VB6 uses Long for pointers
' 4. VB.NET strings are always Unicode
' VB6 can create an ANSI string
' See the following URL for some VB6 / VB.NET details
' http://msdn.microsoft.com/library/default.asp?url=/library/en-us/dnvb600/html/vb6tovbdotnet.asp

Option Explicit On

Imports System.Runtime.InteropServices
Imports System.Drawing.Imaging
Imports System.IO
Imports System.Drawing

Module gsapi

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal dest As IntPtr, ByVal source As IntPtr, ByVal bytes As Long)

'------------------------------------------------
'UDTs Start
'------------------------------------------------
<StructLayout(LayoutKind.Sequential)> Public Structure GS_Revision
Public strProduct As IntPtr
Public strCopyright As IntPtr
Public intRevision As Integer
Public intRevisionDate As Integer
End Structure
'------------------------------------------------
'UDTs End
'------------------------------------------------

'------------------------------------------------
'Callback Functions Start
'------------------------------------------------
'These are only required if you use gsapi_set_stdio
Public Delegate Function StdioCallBack(ByVal handle As IntPtr, ByVal strptr As IntPtr, ByVal count As Integer) As Integer

Public Function gsdll_stdin(ByVal intGSInstanceHandle As IntPtr, ByVal strz As IntPtr, ByVal intBytes As Integer) As Integer
' This is dumb code that reads one byte at a time
' Ghostscript doesn't mind this, it is just very slow
If intBytes = 0 Then
gsdll_stdin = 0
Else
Dim ich As Integer = Console.Read()
If ich = -1 Then
gsdll_stdin = 0 ' EOF
Else
Dim bch As Byte = ich
Dim gcByte As GCHandle = GCHandle.Alloc(bch, GCHandleType.Pinned)
Dim ptrByte As IntPtr = gcByte.AddrOfPinnedObject()
CopyMemory(strz, ptrByte, 1)
ptrByte = IntPtr.Zero
gcByte.Free()
gsdll_stdin = 1
End If
End If
End Function

Public Function gsdll_stdout(ByVal intGSInstanceHandle As IntPtr, ByVal strz As IntPtr, ByVal intBytes As Integer) As Integer
' If you can think of a more efficient method, please tell me!
' We need to convert from a byte buffer to a string
' First we create a byte array of the appropriate size
Dim aByte(intBytes) As Byte
' Then we get the address of the byte array
Dim gcByte As GCHandle = GCHandle.Alloc(aByte, GCHandleType.Pinned)
Dim ptrByte As IntPtr = gcByte.AddrOfPinnedObject()
' Then we copy the buffer to the byte array
CopyMemory(ptrByte, strz, intBytes)
' Release the address locking
ptrByte = IntPtr.Zero
gcByte.Free()
' Then we copy the byte array to a string, character by character
Dim str As String = ""

For i As Integer = 0 To intBytes - 1
str = str + Chr(aByte(i))
Next
' Finally we output the message
Console.Write(str)
gsdll_stdout = intBytes
End Function

Public Function gsdll_stderr(ByVal intGSInstanceHandle As IntPtr, ByVal strz As IntPtr, ByVal intBytes As Integer) As Integer
gsdll_stderr = gsdll_stdout(intGSInstanceHandle, strz, intBytes)
End Function
'------------------------------------------------
'Callback Functions End
'------------------------------------------------

'------------------------------------------------
'API Calls Start
'------------------------------------------------
'Win32 API
'GhostScript API
' Public Declare Function gsapi_revision Lib "gsdll32.dll" (ByVal pGSRevisionInfo As IntPtr, ByVal intLen As Integer) As Integer
Public Declare Function gsapi_revision Lib "gsdll32.dll" (ByRef pGSRevisionInfo As GS_Revision, ByVal intLen As Integer) As Integer
Public Declare Function gsapi_new_instance Lib "gsdll32.dll" (ByRef lngGSInstance As IntPtr, ByVal lngCallerHandle As IntPtr) As Integer
Public Declare Function gsapi_set_stdio Lib "gsdll32.dll" (ByVal lngGSInstance As IntPtr, ByVal gsdll_stdin As StdioCallBack, ByVal gsdll_stdout As StdioCallBack, ByVal gsdll_stderr As StdioCallBack) As Integer
Public Declare Sub gsapi_delete_instance Lib "gsdll32.dll" (ByVal lngGSInstance As IntPtr)
Public Declare Function gsapi_init_with_args Lib "gsdll32.dll" (ByVal lngGSInstance As IntPtr, ByVal lngArgumentCount As Integer, ByVal lngArguments As IntPtr) As Integer
Public Declare Function gsapi_run_file Lib "gsdll32.dll" (ByVal lngGSInstance As IntPtr, ByVal strFileName As String, ByVal intErrors As Integer, ByVal intExitCode As Integer) As Integer
Public Declare Function gsapi_exit Lib "gsdll32.dll" (ByVal lngGSInstance As IntPtr) As Integer
'------------------------------------------------
'API Calls End
'------------------------------------------------

'------------------------------------------------
'User Defined Functions Start
'------------------------------------------------
Public Function StringToAnsiZ(ByVal str As String) As Byte()
' Convert a Unicode string to a null terminated Ansi string for Ghostscript.
' The result is stored in a byte array. Later you will need to convert
' this byte array to a pointer with GCHandle.Alloc(XXXX, GCHandleType.Pinned)
' and GSHandle.AddrOfPinnedObject()
Dim intElementCount As Integer
Dim intCounter As Integer
Dim aAnsi() As Byte
Dim bChar As Byte
intElementCount = Len(str)
ReDim aAnsi(intElementCount + 1)
For intCounter = 0 To intElementCount - 1
bChar = Asc(Mid(str, intCounter + 1, 1))
aAnsi(intCounter) = bChar
Next intCounter
aAnsi(intElementCount) = 0
StringToAnsiZ = aAnsi
End Function

Public Function AnsiZtoString(ByVal strz As IntPtr) As String
' We need to convert from a byte buffer to a string
Dim byteCh(1) As Byte
Dim bOK As Boolean = True
Dim gcbyteCh As GCHandle = GCHandle.Alloc(byteCh, GCHandleType.Pinned)
Dim ptrByte As IntPtr = gcbyteCh.AddrOfPinnedObject()
Dim j As Integer = 0
Dim str As String = ""
While bOK
' This is how to do pointer arithmetic!
Dim sPtr As New IntPtr(strz.ToInt64() + j)
CopyMemory(ptrByte, sPtr, 1)
If byteCh(0) = 0 Then
bOK = False
Else
str = str + Chr(byteCh(0))
End If
j = j + 1
End While
AnsiZtoString = str
End Function

Public Function CheckRevision(ByVal intRevision As Integer) As Boolean
' Check revision number of Ghostscript
Dim intReturn As Integer
Dim udtGSRevInfo As GS_Revision
Dim gcRevision As GCHandle
gcRevision = GCHandle.Alloc(udtGSRevInfo, GCHandleType.Pinned)
intReturn = gsapi_revision(udtGSRevInfo, 16)
Console.WriteLine("Revision = " & udtGSRevInfo.intRevision)
Console.WriteLine("RevisionDate = " & udtGSRevInfo.intRevisionDate)
Console.WriteLine("Product = " & AnsiZtoString(udtGSRevInfo.strProduct))
Console.WriteLine("Copyright = " & AnsiZtoString(udtGSRevInfo.strCopyright))

If udtGSRevInfo.intRevision = intRevision Then
CheckRevision = True
Else
CheckRevision = False
End If
gcRevision.Free()
End Function

Public Function CallGS(ByVal astrGSArgs() As String) As Boolean
Dim intReturn As Integer
Dim intGSInstanceHandle As IntPtr
Dim aAnsiArgs() As Object
Dim aPtrArgs() As IntPtr
Dim aGCHandle() As GCHandle
Dim intCounter As Integer
Dim intElementCount As Integer
'Dim iTemp As Integer
Dim callerHandle As IntPtr
Dim gchandleArgs As GCHandle
Dim intptrArgs As IntPtr

' Print out the revision details.
' If we want to insist on a particular version of Ghostscript
' we should check the return value of CheckRevision().
CheckRevision(704)

' Load Ghostscript and get the instance handle
intReturn = gsapi_new_instance(intGSInstanceHandle, callerHandle)
If (intReturn < 0) Then
Return (False)
End If

' Capture stdio
Dim stdinCallback As StdioCallBack
stdinCallback = AddressOf gsdll_stdin
Dim stdoutCallback As StdioCallBack
stdoutCallback = AddressOf gsdll_stdout
Dim stderrCallback As StdioCallBack
stderrCallback = AddressOf gsdll_stderr
intReturn = gsapi_set_stdio(intGSInstanceHandle, stdinCallback, stdoutCallback, stderrCallback)

If (intReturn >= 0) Then
' Convert the Unicode strings to null terminated ANSI byte arrays
' then get pointers to the byte arrays.
intElementCount = UBound(astrGSArgs)
ReDim aAnsiArgs(intElementCount)
ReDim aPtrArgs(intElementCount)
ReDim aGCHandle(intElementCount)
For intCounter = 0 To intElementCount
aAnsiArgs(intCounter) = StringToAnsiZ(astrGSArgs(intCounter))
aGCHandle(intCounter) = GCHandle.Alloc(aAnsiArgs(intCounter), GCHandleType.Pinned)
aPtrArgs(intCounter) = aGCHandle(intCounter).AddrOfPinnedObject()
Next
gchandleArgs = GCHandle.Alloc(aPtrArgs, GCHandleType.Pinned)
intptrArgs = gchandleArgs.AddrOfPinnedObject()
callerHandle = IntPtr.Zero

intReturn = gsapi_init_with_args(intGSInstanceHandle, intElementCount + 1, intptrArgs)

' Release the pinned memory
For intCounter = 0 To intElementCount
aGCHandle(intCounter).Free()
Next
gchandleArgs.Free()

' Stop the Ghostscript interpreter
gsapi_exit(intGSInstanceHandle)
End If

' release the Ghostscript instance handle
gsapi_delete_instance(intGSInstanceHandle)

If (intReturn >= 0) Then
CallGS = True
Else
CallGS = False
End If

End Function

Private Sub ClearTempFolder(ByVal path As String)
Dim folder As New DirectoryInfo(path)
Dim files() As FileInfo = folder.GetFiles()
For Each fi As FileInfo In files
fi.Delete()
Next
End Sub

Public Sub OutputToTiff(ByVal tifPath As String)
Dim folder As New DirectoryInfo(tmpFolder)
Dim files() As FileInfo = folder.GetFiles("*.tiff")
If files.Length > 0 Then
Dim imgs(files.Length - 1) As Image
SortByName(files)

For i As Integer = 0 To files.Length - 1
imgs(i) = Image.FromFile(files(i).FullName)
Next
saveMultipage(imgs, tifPath, "TIFF")
For Each img As Image In imgs
img.Dispose()
Next

'ClearTempFolder(tmpFolder)
End If
Directory.Delete(tmpFolder, True)
End Sub

Private tmpFolder As String

Private Function GetTempFolder() As String
Dim g As Guid = Guid.NewGuid()
While Directory.Exists(tmpFolder & "\" & g.ToString())
g = New Guid()
End While
Return tmpFolder & "\" & g.ToString()
End Function


Public Function ConvertFile(ByVal tifPath As String, ByVal pdfSource As String, ByVal tempFolder As String, ByVal startUpStr As String) As Boolean
tmpFolder = tempFolder

tmpFolder = GetTempFolder()
Directory.CreateDirectory(tmpFolder)
'ClearTempFolder("c:\temp\tiff")
Dim astrArgs(16) As String
astrArgs(0) = "accfax" 'The First Parameter is Ignored
astrArgs(1) = startUpStr
astrArgs(2) = "-dNOPAUSE"
astrArgs(3) = "-dBATCH"
astrArgs(4) = "-dSAFER"
astrArgs(5) = "-sDEVICE=tiffg4"
astrArgs(6) = "-r300"
astrArgs(7) = "-sOutputFile=" & tmpFolder & "\%03d.tiff"
astrArgs(8) = "-dDEVICEXRESOLUTION=204"
astrArgs(9) = "-dDEVICEYRESOLUTION=196"
astrArgs(10) = "-dDEVICEWIDTH=1686"
astrArgs(11) = "-dDEVICEHEIGHT=2292"
astrArgs(12) = "-dNOPLATFONTS"
astrArgs(13) = "-sFONTPATH=""c:\psfonts\"""
astrArgs(14) = "-c ""<< /Policies << /PageSize 5 >> /PageSize [595 842]/InputAttributes currentpagedevice /InputAttributes get mark exch {1index /Priority eq not {pop << /PageSize [595 842] >>} if } forall >>setpagedevice"" -f"""
astrArgs(15) = "-f"
astrArgs(16) = pdfSource
If CallGS(astrArgs) Then
OutputToTiff(tifPath)
End If

End Function

Private Function InteractiveGS() As Boolean
Dim astrArgs(2) As String
astrArgs(0) = "gs" 'The First Parameter is Ignored
astrArgs(1) = "-c"
astrArgs(2) = "systemdict /start get exec"
Return CallGS(astrArgs)
End Function


'------------------------------------------------
'User Defined Functions End
'------------------------------------------------

'Sub Main()
' ConvertFile()
' 'InteractiveGS()
' MsgBox("Done")
'End Sub

#Region "multi-pages tiff generation"
Private Function saveMultipage(ByVal bmp() As Image, ByVal location As String, ByVal type As String) As Boolean
If Not bmp Is Nothing Then
Try
Dim codecInfo As ImageCodecInfo = getCodecForstring(type)


For i As Integer = 0 To bmp.Length - 1
If bmp(i) Is Nothing Then
Exit For
End If
bmp(i) = CType(ConvertToBitonal(CType(bmp(i), Bitmap)), Image)
Next

If bmp.Length = 1 Then

Dim iparams As EncoderParameters = New EncoderParameters(1)
Dim iparam As Encoder = Encoder.Compression
Dim iparamPara As EncoderParameter = New EncoderParameter(iparam, CType((EncoderValue.CompressionCCITT4), Long))
iparams.Param(0) = iparamPara
bmp(0).Save(location, codecInfo, iparams)


ElseIf bmp.Length > 1 Then

Dim saveEncoder As Encoder
Dim compressionEncoder As Encoder
Dim SaveEncodeParam As EncoderParameter
Dim CompressionEncodeParam As EncoderParameter
Dim EncoderParams As EncoderParameters = New EncoderParameters(2)

saveEncoder = Encoder.SaveFlag
compressionEncoder = Encoder.Compression

' Save the first page (frame).
SaveEncodeParam = New EncoderParameter(saveEncoder, CType(EncoderValue.MultiFrame, Long))
CompressionEncodeParam = New EncoderParameter(compressionEncoder, CType(EncoderValue.CompressionCCITT4, Long))
EncoderParams.Param(0) = CompressionEncodeParam
EncoderParams.Param(1) = SaveEncodeParam

File.Delete(location)
bmp(0).Save(location, codecInfo, EncoderParams)



For i As Integer = 1 To bmp.Length - 1
If bmp(i) Is Nothing Then
Exit For
End If

SaveEncodeParam = New EncoderParameter(saveEncoder, CType(EncoderValue.FrameDimensionPage, Long))
CompressionEncodeParam = New EncoderParameter(compressionEncoder, CType(EncoderValue.CompressionCCITT4, Long))
EncoderParams.Param(0) = CompressionEncodeParam
EncoderParams.Param(1) = SaveEncodeParam
bmp(0).SaveAdd(bmp(i), EncoderParams)
bmp(i).Dispose()
Next

SaveEncodeParam = New EncoderParameter(saveEncoder, CType(EncoderValue.Flush, Long))
EncoderParams.Param(0) = SaveEncodeParam
bmp(0).SaveAdd(EncoderParams)
bmp(0).Dispose()
End If
Return True


Catch ee As System.Exception
Throw New Exception(ee.Message + " Error in saving as multipage ")
End Try
Else
Return False
End If

End Function

Private Function getCodecForstring(ByVal type As String) As ImageCodecInfo
Dim info() As ImageCodecInfo = ImageCodecInfo.GetImageEncoders()

Dim i As Integer
For i = 0 To info.Length - 1 Step i + 1
Dim EnumName As String = type.ToString()
If info(i).FormatDescription.Equals(EnumName) Then
Return info(i)
End If
Next

Return Nothing

End Function

Private Function ConvertToBitonal(ByVal original As Bitmap) As Bitmap
Dim source As Bitmap = Nothing

' If original bitmap is not already in 32 BPP, ARGB format, then convert
If original.PixelFormat <> PixelFormat.Format32bppArgb Then
source = New Bitmap(original.Width, original.Height, PixelFormat.Format32bppArgb)
source.SetResolution(original.HorizontalResolution, original.VerticalResolution)
Using g As Graphics = Graphics.FromImage(source)
g.DrawImageUnscaled(original, 0, 0)
End Using
Else
source = original
End If

' Lock source bitmap in memory
Dim sourceData As Imaging.BitmapData = source.LockBits(New Rectangle(0, 0, source.Width, source.Height), ImageLockMode.ReadOnly, PixelFormat.Format32bppArgb)

' Copy image data to binary array
Dim imageSize As Integer = sourceData.Stride * sourceData.Height
Dim sourceBuffer(imageSize) As Byte
Marshal.Copy(sourceData.Scan0, sourceBuffer, 0, imageSize)

' Unlock source bitmap
source.UnlockBits(sourceData)

' Create destination bitmap
Dim destination As Bitmap = New Bitmap(source.Width, source.Height, PixelFormat.Format1bppIndexed)

' Lock destination bitmap in memory
Dim destinationData As BitmapData = destination.LockBits(New Rectangle(0, 0, destination.Width, destination.Height), ImageLockMode.WriteOnly, PixelFormat.Format1bppIndexed)

' Create destination buffer
imageSize = destinationData.Stride * destinationData.Height
Dim destinationBuffer(imageSize) As Byte

Dim sourceIndex As Integer = 0
Dim destinationIndex As Integer = 0
Dim pixelTotal As Integer = 0
Dim destinationValue As Byte = 0
Dim pixelValue As Integer = 128
Dim height As Integer = source.Height
Dim width As Integer = source.Width
Dim threshold As Integer = 500

' Iterate lines

For y As Integer = 0 To height - 1
sourceIndex = y * sourceData.Stride
destinationIndex = y * destinationData.Stride
destinationValue = 0
pixelValue = 128

' Iterate pixels
For x As Integer = 0 To width - 1
' Compute pixel brightness (i.e. total of Red, Green, and Blue values)
pixelTotal = CType(sourceBuffer(sourceIndex + 1), Integer) + CType(sourceBuffer(sourceIndex + 2), Integer) + CType(sourceBuffer(sourceIndex + 3), Integer)
If pixelTotal > threshold Then
destinationValue += CType(pixelValue, Byte)
End If
If pixelValue = 1 Then
destinationBuffer(destinationIndex) = destinationValue
destinationIndex = destinationIndex + 1
destinationValue = 0
pixelValue = 128
Else
pixelValue = pixelValue >> 1
End If
sourceIndex += 4
Next
If pixelValue <> 128 Then
destinationBuffer(destinationIndex) = destinationValue
End If
Next

' Copy binary image data to destination bitmap
Marshal.Copy(destinationBuffer, 0, destinationData.Scan0, imageSize)

' Unlock destination bitmap
destination.UnlockBits(destinationData)
original.Dispose()
' Return
Return destination
End Function

Private Function Compare(ByVal d1 As FileInfo, ByVal d2 As FileInfo) As Integer
Return d1.Name.CompareTo(d2.Name)
End Function

Private Sub SortByName(ByVal files As FileInfo())
Array.Sort(Of FileInfo)(files, New Comparison(Of FileInfo)(AddressOf Compare))

End Sub

#End Region

End Module

SqlCommand to Sql statement

18. July 2010 22:31 by Jerry in Old blog posts

Recently I have a requirement that log down the message when an error occurs on the server. If the error was caused by execution of SQL statement, log that as well.

It came to a problem that when the SQL is carried by a SqlCommand object, there is no any built-in function to get back the SQL statement in a string format. I wrote a small VB module to do the job.

The primary idea is going through the CommandText, record every place (replace index) that need to replace the parameter name (starts with “@"), and then replace them.

 

The code is written in VB.NET, but it should not be difficult to convert to C# by using http://www.developerfusion.com/tools/convert/vb-to-csharp/

Usage:

smply call SqlCommandToSql and pass in a SqlCommand object.

Dim cmd As New SqlClient.SqlCommand()
cmd.CommandText = "update abcd set a=@a,b=@ab, c=@abc where cd=@a"
cmd.Parameters.Add("@a", SqlDbType.VarChar).Value = "a@aa"
cmd.Parameters.Add("@ab", SqlDbType.Bit).Value = False
cmd.Parameters.Add("@abc", SqlDbType.DateTime).Value = Now
MsgBox(SqlCommandToSql(cmd)) 

 

source code:

Imports System.Data.SqlClient

Friend Module Module1
Private Class ReplaceIndex
Implements IComparable

Public Index As Integer
Public ParaName As String
Public Sub New(ByVal idx As Integer, ByVal para As String)
Index = idx
ParaName = para
End Sub

Public Function CompareTo(ByVal obj As Object) As Integer Implements System.IComparable.CompareTo
Dim r As ReplaceIndex = DirectCast(obj, ReplaceIndex)
Return Me.Index - r.Index
End Function
End Class

Private Function GetParaValue(ByVal para As SqlParameter) As String
Dim value As String = ""
If para.Value Is Nothing Then
'it should throw an error if an parameter had not set value
'but here just make it through
value = "Nothing"
End If
If para.Value Is DBNull.Value Then
value = "NULL"
End If
value = para.Value.ToString()
'special handle for some types
Select Case para.SqlDbType
Case SqlDbType.VarChar, SqlDbType.Char, SqlDbType.Text, SqlDbType.NChar, SqlDbType.NText, SqlDbType.NVarChar
value = "'" & value.Replace("'", "''") & "'"
Case SqlDbType.Date, SqlDbType.DateTime, SqlDbType.DateTime2, SqlDbType.Time
value = "'" & value & "'"
Case SqlDbType.Binary, SqlDbType.Image, SqlDbType.VarBinary, SqlDbType.Timestamp
value = "0x" & BitConverter.ToString(TryCast(para.Value, Byte())).Replace("-", "")
Case SqlDbType.Bit
If TypeOf para.Value Is Boolean Then
value = IIf(para.Value, "1", "0")
End If
End Select
Return value
End Function

Private Sub Replace(ByRef source As String, ByVal startIdx As Integer, ByVal paraName As String, ByVal paraType As SqlDbType, ByVal value As String)
Dim len As Integer = paraName.Length
source = source.Remove(startIdx, len)
source = source.Insert(startIdx, value)

End Sub




Public Function SqlCommandToSql(ByVal cmd As SqlCommand) As String
'loop through the parameters
'record the start index where need to replace every para name
'loop the index array, replace para name one by one
'when replace one, need to adjust the rest indexs, since the string length might be changed
Dim index As New Hashtable()

Dim sql As String = cmd.CommandText

For Each p As SqlParameter In cmd.Parameters
FindIndex(index, sql, 0, p)
'index.Add(p, idx)
Next

Dim keyCollection As ICollection = index.Keys
Dim keys As ReplaceIndex() = New ReplaceIndex(keyCollection.Count - 1) {}
keyCollection.CopyTo(keys, 0)
'sort the index first
Array.Sort(keys)

Dim offset As Integer = 0
'loop through each replace point(index)
For i As Integer = 0 To keys.Length - 1
Dim r As ReplaceIndex = DirectCast(keys(i), ReplaceIndex)
Dim p As SqlParameter = DirectCast(index(r), SqlParameter)
Dim value As String = GetParaValue(p)
r.Index += offset
Replace(sql, r.Index, p.ParameterName, p.SqlDbType, value)
'calc the total offset
offset += value.Length - p.ParameterName.Length
Next

Return sql
End Function

Private Sub FindIndex(ByVal ht As Hashtable, ByVal source As String, ByVal startIdx As Integer, ByVal para As SqlParameter)
Dim idx As Integer = source.IndexOf(para.ParameterName, startIdx)
If idx < 0 Then
'no more match is found
Exit Sub
End If
Dim idx2 As Integer = source.LastIndexOf(para.ParameterName)
If idx = idx2 Then
'only one match in the remaining string
idx2 += para.ParameterName.Length
If idx2 >= source.Length Then
Dim r As New ReplaceIndex(idx, para.ParameterName)
ht.Add(r, para)
Else
Dim nextChar As String = source.Substring(idx2, 1)
'if the next char is special charater, this is the match we are looking for
If " ~!@#$%^&*()+-={}[]\|;:,./?'""".Contains(nextChar) Then
Dim r As New ReplaceIndex(idx, para.ParameterName)
ht.Add(r, para)

End If
End If

Exit Sub
End If

'more than once match the parameter name
'e.g. @a will match @a, @ab and @abc, etc.
'store each start index
Dim index As New List(Of Integer)
index.Add(idx)
'index.Add(idx2)
idx = source.IndexOf(para.ParameterName, idx + para.ParameterName.Length)
While idx <> idx2
index.Add(idx)
idx = source.IndexOf(para.ParameterName, idx + para.ParameterName.Length)
End While
'find the actual match index
For Each i As Integer In index
idx2 = i + para.ParameterName.Length
startIdx = idx2
If idx2 = source.Length Then
'this match is the last one (reach the end of source string)
Dim r As New ReplaceIndex(i, para.ParameterName)
ht.Add(r, para)
Exit Sub
Else
Dim nextChar As String = source.Substring(idx2, 1)
'if the next char is special charater, this is the match we are looking for
If " ~!@#$%^&*()+-={}[]\|;:,./?'""".Contains(nextChar) Then
Dim r As New ReplaceIndex(i, para.ParameterName)
ht.Add(r, para)

FindIndex(ht, source, startIdx, para)
Exit Sub
End If
End If
Next
FindIndex(ht, source, startIdx, para)
End Sub
End Module

How to be compatible with UpdatePanel or ASP.NET AJAX

18. July 2010 22:26 by Jerry in Old blog posts

Suppose you have following function in your project:

C# Code:

    [code language=C#]    public void MessageBox(string msgText)
        {
            string scriptKey = "Message";

            if (!ClientScript.IsStartupScriptRegistered(scriptKey))
            {
                ClientScript.RegisterStartupScript(this.GetType(), scriptKey, "<script>alert('" + msgText + "')</script>");
            }
        }[/code]

VB Code:

   [code language=vb.net] Protected Sub MessageBox(ByVal strMsg As String)

        Dim key As String = "Message"

            If Not ClientScript.IsStartupScriptRegistered(key) Then
                ClientScript.RegisterStartupScript(Me.GetType(), key, "<script>alert('" + strMsg + "');</script>")
            End If
        End If
    End Sub [/code]

This function is to show a client-side message box by using javascript. You might utilize this function like this:

C# Code:

        [code language=C#]protected void btnSearch_Click(object sender, EventArgs e)
        {

            ......code omitted
            MessageBox("Search completed!");

        }[/code]

VB Code:

  [code language=vb.net]  Protected Sub btnSearch_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnSearch.Click

        ......code omitted

        MessageBox("Search completed!")

    End Sub[/code]

The code above has no problem at all if not using AJAX. With Ajax extension however, the button "btnSearch" will be placed inside an UpdatePanel control to avoid the page being post-back.  The MessageBox will not work as normal any more afterward. In such case, you might need to do some extra work on the MessageBox method.

C# Code:

       [code language=C#] public void MessageBox(string msgText)
        {
            string scriptKey = "Message";

            if (ScriptManager.GetCurrent(this.Page)!=null && ScriptManager.GetCurrent(this.Page).IsInAsyncPostBack {

               ScriptManager.RegisterStartupScript(this, this.GetType(), scriptKey , "alert('" + msgText+ "');", true);


            }else {

               if (!ClientScript.IsStartupScriptRegistered(scriptKey))
               {
                 ClientScript.RegisterStartupScript(this.GetType(), scriptKey, "<script>alert('" + msgText + "')</script>");
               }

            }
        }[/code]

VB Code:

    [code language=vb.net]Protected Sub MessageBox(ByVal strMsg As String)

        Dim key As String = "Message"

        If ScriptManager.GetCurrent(Me.Page) IsNot Nothing AndAlso ScriptManager.GetCurrent(Me.Page).IsInAsyncPostBack Then
            'to support ajax post back
            ScriptManager.RegisterStartupScript(Me, Me.GetType(), key, "alert('" + strMsg + "');", True)
        Else
            'normal call
            If Not ClientScript.IsStartupScriptRegistered(key) Then
                ClientScript.RegisterStartupScript(Me.GetType(), key, "<script>alert('" + strMsg + "');</script>")
            End If
        End If
    End Sub[/code]

Simply use RegisterStartupScript from ScriptManager (System.Web.Extension.dll) to generate javascript code instead of that from Page object.

Hope you enjoy with ASP.NET AJAX again!

Make StaticSiteMapProvider dynamically

18. July 2010 22:18 by Jerry in Old blog posts

The term "dynamic" has 2 meanings:
1) dynamically generate menu data when user click on the menu; and
2) generate menu in per user basis.
In this paper I only discuss the second one.
 
In ASP.NET 2.0,  together with Menu or TreeView control, you can use StaticSiteMapProvider to generate a "static" hierarchical navigation menu to the end user.  Most of the StaticSiteMapProvider sub-classes look like this:
 [code language=C#]
 public class SiteMapProvider : StaticSiteMapProvider {
        private SiteMapNode root = null;
        public override SiteMapNode BuildSiteMap()
        {
            if (root != null) return root;
            lock (this)
            {
                base.Clear();
                ...generate your menu data here, e.g. get data from database
                root = new SiteMapNode(.......
            }
            return root;
        }
..............................
}//end of class[/code]
The BuildSiteMap function will run once and once only when the first visitor was opening the website, the root object will then be saved persistently and being reused during the lifetime of the web application. You may consider the root object as an application variable if you feel difficult to understand. As a result, other visitors will get exactly the same menu as the first one. That's why it named itself "Static".
 
In practice however, we are more prefer to get different menu items according to the login user's role or access right settings, rather than the stupid static items. A simple solution to make the SiteMapProvider dynamically is to discard the "root" - comment the first line of code, and that's it.
[code language=C#]        public override SiteMapNode BuildSiteMap()
        {
            //if (root != null) return root;[/code]

It works as you expected, but this is extremely inefficient; "as multiple concurrent page requests can result indirectly in multiple calls to load site map information" (i.e. to run BuildSiteMap) - the MSDN explains. Set a breakpoint inside BuildSiteMap function, you will find what MSDN said is true. Loading one single page in the web project will call BuildSiteMap many times. Alright, if that is the case, the only thing we need is a session variable to make sure every users only run the BuildSiteMap once.  The final code:

[code language=C#]public class DynamicSiteMapProvider : StaticSiteMapProvider {
//a kindly reminder that all private fields inside this class will be persistently available during the lifetime
//please remember to do extra init with these fields in the BuildSiteMap method

        private SiteMapNode root = null;
        public override SiteMapNode BuildSiteMap()
        {
            if (root != null&&HttpContext.Current.Session["AlreadySet"]!=null) return root;
            lock (this)
            {
                //next line is better to put on the first statement after "if", for concurrent reason
                HttpContext.Current.Session["AlreadySet"] = true;
                base.Clear();
                root = null;//init
                ...get "per-user" menu data here
                root = new SiteMapNode(......
 
            }
            return root;
        }
.................other code omitted....
}//end of class[/code]
 The solution above is trivial, a bit informal yet feasible. Actually SiteMapProvider has a property "securityTrimmingEnabled" to specify if the Provider equip with role. In that case, you need to override the "IsAccessibleToUser" method. More information please visit:
http://fredrik.nsquared2.com/viewpost.aspx?PostID=272&showfeedback=true
http://blogs.msdn.com/dannychen/archive/2006/03/16/553005.aspx

In order to finally solved the problem with a formal solution, we need to work with the ASP.NET 2.0 Role Manager, and Membership Provider if you want to.

First of all, define a series of roles that what menu/urls in your project they can access to, then modify your data structure to place your role information. E.g. add a "roles" field in your sitemap database table if you are using database storage. Using the following format if you are using xml file to store the sitemap:

[code language=XML] <siteMapNode title="Home" description="Home" url="~/default.aspx" roles="*">
  <siteMapNode title="menu 1" description="" roles="Admin,User" >
   <siteMapNode  roles="Admin" title="Admin Item" description="" url="~/admin.aspx" />
   <siteMapNode roles="User" title="User Item" description="" url="~/user.aspx" />
  </siteMapNode>
 </siteMapNode>[/code]

the menu will look like:
Home  (can be accessed by all users)
  - menu 1 (can be accessed by Admin and User
    - Admin Item (Can be accessed by Admin only)
    - User Item (can be accessed by User only)

*note: if you are not going to write your own xml SiteMapProvider, the ASP.NET 2.0 already has a simple one for you - System.Web.XmlSiteMapProvider. BUT, please be aware that the XmlSiteMapProvider only supports security trimming on menu/node who has child-node. In this case, if using XmlSiteMapProvider, the security trimming setting only works for "menu 1". In other word, "Admin Item" and "User Item" will be accessed by both "Admin" and "User" as "menu 1" specify.

Then, modify the Login.aspx:

[code language=C#]....After verifying the login username and password
.... and get the roleName of login user
//init the roles, clean login user's role
string[] allRoles={"Admin","User"};
foreach (string role in allRoles)
{
    if (!Roles.RoleExists(role)) Roles.CreateRole(role);
    if (Roles.IsUserInRole(user, role)) Roles.RemoveUserFromRole(user, role)
}
//add the user to the role s/he belongs to
Roles.AddUserToRole(user, roleName);[/code]

Finally, modify the BuildSiteMap method of  SiteMapProvider, and override the IsAccessibleToUser. The main difference from previous version is that in the BuildSiteMap function, instead of loading "per-user" menu data, we just load a full set of menu, leave the IsAccessibleToUser to determine if a node should be shown or access to. 

[code language=C#]public override SiteMapNode BuildSiteMap()
        {
            if (root != null) return root;

            lock (this)
            {
                base.Clear();
                ...get a full set of menu data here, but don't forget attaching role information to a node
                ... for example
                string role = .....get the roles of this menu, from database or xml, e.g "Admin,User"
                IList roles = new ArrayList();
                if (!string.IsNullOrEmpty(role)) {
                   string[] r=role.Split(",");
                   foreach (string item in r)
                       roles.Add(item)
               }
               SiteMapNode node = New SiteMapNode(this, menukey, url, title, desc, roles, null, null, null)
               ......other code omitted....
            }
            return root;
        }
public override bool IsAccessibleToUser (System.Web.HttpContext context, System.Web.SiteMapNode node)
        {
            if (!this.SecurityTrimmingEnabled) return true;
            if (node ==null || context==null || context.User==null) return false;
            if (node.Roles==null || node.Roles.Count<=0) return false;
            foreach(string role in node.Roles)
                if (role.Equals("*") || context.User.IsInRole(role))
                    return true;
            return false;
        }
 [/code]
Last step, don't forget to set SecurityTrimmingEnabled to true in web.config file.

   [code language=XML] <siteMap defaultProvider="DynamicSiteMapProvider" enabled="true">
      <providers>
        <add name="DynamicSiteMapProvider" type="myProject.DynamicSiteMapProvider"  securityTrimmingEnabled="true" />
      </providers>
    </siteMap>[/code]