technofantasy
博客园 首页 新随笔 联系 订阅 管理
  20 Posts :: 16 Stories :: 52 Comments :: 0 Trackbacks

2007年3月5日 #

让微软出钱捐助难民吧
今天突然发现Live Messenger上很多好友都出现了user posted image的图标，感觉挺新鲜的。而且好多组合都可以打出这个表情。上网搜索了一下，原来这是微软的一个捐助计划。只要在Live Messenger上把以下面任一词组放到你的昵称里，每发起一次对话，微软就会给一个叫ninemillion.org的网站捐助以帮助一些难民。
*sierra
*bgca
*9mil
*hsus
*komen
*one
*mssoc
*care
*acs
*oxfam
*mod
*help
*red+u
*unicef
*wwf
*naf
据说除了Live Messenger之外，Live Search和Live Sapce都有相关的捐助活动。


大家都在自己的MSN里面加上这个表情吧。
posted @ 2007-03-05 15:59 陈锐 阅读(562) | 评论 (5) | 编辑

2007年3月3日 #

能够下载时改名的文件权限管理
最近写代码需要实现文件权限管理，这个通过一个自定义的HttpHandler就可以实现。但是
下载文件的时候需要修改文件名，比如在服务器上存储的文件是一个类似ab739s48fssa.txt
的文件，但是用户下载看到的是readme.txt。网上查了半天，其实实现很简单，下面是实现
步骤。
首先需要在web.config终定义自定义的HttpHandler：
    <httpHandlers>
      <add verb="*" path="Attachments/*.*" type="AttachmentHandler" />
    </httpHandlers>
然后实现自定义的AttchmentHandler类：
Imports Microsoft.VisualBasic
Imports System.Data
Imports System.Data.Sql
Imports System.Data.SqlClient
Imports System.Diagnostics
Imports System.IO

Public Class AttachmentHandler
    Implements IHttpHandler


    Public ReadOnly Property IsReusable() As Boolean Implements System.Web.IHttpHandler.IsReusable
        Get
            Return True
        End Get
    End Property

    Public Sub ProcessRequest(ByVal context As System.Web.HttpContext) Implements System.Web.IHttpHandler.ProcessRequest
        '判断用户是否通过验证
        If (context.User.Identity.IsAuthenticated) Then
            Dim splitter As String() = context.Request.FilePath.Split("/")
            '获得用户选择下载的文件名
            Dim filename As String = splitter(UBound(splitter))
            '获得文件全路径名
            Dim fullfilename As String = context.Server.MapPath(context.Request.FilePath)

                        '指定用户下载时的文件名
            Dim orifilename As String = "readme.txt"
            '获得文件类型
            Dim strContentType As String = GetFileContentType(filename)

            context.Response.ContentType = strContentType
            context.Response.AppendHeader("content-disposition", "attachment;filename=" + orifilename)

            '读取文件内容到字节数组
            Dim file As FileStream = _
                    New FileStream(fullfilename, FileMode.Open, FileAccess.Read)
            Dim buff(file.Length) As Byte
            file.Read(buff, 0, buff.Length)
            '将字节数组中的内容输出到输出缓存
            context.Response.OutputStream.Write(buff, 0, buff.Length)
        Else
            context.Response.Redirect("Login.aspx")
        End If
    End Sub
End Class

实现文件改名的关键就是在Response头部加入：
context.Response.AppendHeader("content-disposition", "attachment;filename=" + orifilename)
其中orifilename就是想让用户看到的文件名。
posted @ 2007-03-03 00:05 陈锐 阅读(100) | 评论 (0) | 编辑

2006年12月20日 #

你的博客的性别是什么？
想知道你自己的博客的性别么？进入：http://www.yodao.com/blogender/。
输入你的博客地址就可以了，下面是我的博客性别：
博客园-technofantasy
93.0%男性倾向,7.0%女性倾向
评点：您的文风冷静而镇定，言语间展现出强悍的思辨能力与恢宏的胸襟，一个男子汉的阳刚形象跃然纸上。
yodao | 博客男女
posted @ 2006-12-20 17:33 陈锐 阅读(68) | 评论 (0) | 编辑

2006年10月25日 #

湖南微软开发者俱乐部成立大会顺利召开
成立大会是在10月21号下午在牛耳教育中心的8楼举办的。我作为俱乐部的资深顾问参加了会议。先上点图片：


会场盛况，前面是我和俱乐部主席贺天明在听课，前面的牌子就是湖南俱乐部的牌子。


会场图2，我在上面讲课。嘿嘿。


博文视点制作总监方舟在发言


俞晖在讲课，图片有点黑。


微软讲师徐栋在讲VISTA开发


俱乐部主席贺天明在抽奖（抽奖是我们临时写的一个程序，嘿嘿）


抽奖的头等奖获得者

下面是会后合影

俱乐部的几个牛人的合影


牛耳教育中心的学术部经理邹伟、我、俞晖



俱乐部成员合影，左边第２个是副主席帅哥许桌．俱乐部的场地就是他联系的。有对爬8楼不满的可以去扁他。

最后还要非常感谢长沙牛耳计算机教育提供的场地，以及博文视点提供的书籍赞助。希望下次活动更成功！
posted @ 2006-10-25 09:55 陈锐 阅读(362) | 评论 (20) | 编辑

2006年10月17日 #

湖南微软.NET俱乐部 成立大会事宜
湖南微软.NET俱乐部成立大会将于2006年10月21日举办，地点在51广场口腔医院后的牛耳教育中心8楼。

活动报名QQ群：18993902

活动的流程安排如下：
 1:30-2:00    签到
 2:00-2:30    介绍俱乐部
 2:30-2:45    介绍 LOVE@Community
 2:50-3:50    办公无处不在－Office 2007客户端开发(或Vista开发相关)
 4:00-4:30    博文视点和.NET俱乐部出版合作方案
 4:30-4:50    牛耳软件教育中心介绍
 5:00         抽奖、赠书、Q&A 、合影留念

本次活动由微软支持，牛耳提供场地，并且由博文视点提供活动抽奖奖品以及俱乐部书籍。
博文视点提供的书目有：

　　 1、《代码大全》第二版
 
     2、《程序员》杂志
 
     3、《最优化ASP.NET 》
 
     4、《SQL Server 2005 数据库开发详解》
 
     5、《SharePoint portal server2003 深入指南 》
 
     6、《应用框架的设计与实现》

下面列出这些书的封面：

最优化ASP.NET

代码大全第二版


应用框架的设计与实现

SharePoint portal server2003 深入指南

SQL server 2005 数据库开发详解

posted @ 2006-10-17 17:02 陈锐 阅读(346) | 评论 (4) | 编辑

2006年10月2日 #

在VB.NET中如何使在Webbrowser中实现标签页中打开新链接
操作步骤：
1、在工程中添加COM的Microsoft Internet Controls的引用（这个引用对应的文件是shdocvw.dll，通常在system32目录下）。
2、添加如下代码：
Public Class Form1
    Private Sub NewWindow3(ByRef ppDisp As Object, ByRef Cancel As Boolean, _
            ByVal dwFlags As UInteger, _
            ByVal bstrUrlContext As String, ByVal bstrUrl As String)

        Dim xPage As TabPage = New TabPage
        xPage.Text = "abcd"
        TabControl1.TabPages.Add(xPage)

        Dim x As New WebBrowser
        DirectCast(WebBrowser1.ActiveXInstance, SHDocVw.WebBrowser).RegisterAsBrowser = True

        xPage.Controls.Add(x)
        x.Dock = DockStyle.Fill
        x.Visible = True

        x.Navigate(bstrUrl)
        Cancel = True
    End Sub


    Private Sub NewWindow2(ByRef ppDisp As Object, ByRef Cancel As Boolean)
        Dim xPage As TabPage = New TabPage
        xPage.Text = "abcd"
        TabControl1.TabPages.Add(xPage)

        Dim x As New WebBrowser
        DirectCast(WebBrowser1.ActiveXInstance, SHDocVw.WebBrowser).RegisterAsBrowser = True

        xPage.Controls.Add(x)
        x.Dock = DockStyle.Fill
        x.Visible = True
        x.Navigate("about:blank")

        ppDisp = x.ActiveXInstance 'DirectCast(x.ActiveXInstance, SHDocVw.WebBrowser).Application
        'Cancel = True
    End Sub


    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        '在窗体载入后设置Webbrowser的NewWindow3事件处理函数
        'AddHandler DirectCast(WebBrowser1.ActiveXInstance, SHDocVw.WebBrowser).NewWindow3, AddressOf NewWindow3
        '如果不是Windows XP SP2的话需要监控NewWindow2消息
        AddHandler DirectCast(WebBrowser1.ActiveXInstance, SHDocVw.WebBrowser).NewWindow2, AddressOf NewWindow2

        WebBrowser1.Navigate("http://www.applevb.com")
    End Sub

End Class

运行程序，可以看到新打开的窗口都会在TabControl１的新标签页中打开．在上面的代码中，如果是Windows XP+SP2的话可以监控NewWindow3事件，否侧需要监控NewWindow2事件。

posted @ 2006-10-02 10:50 陈锐 阅读(2262) | 评论 (0) | 编辑

2006年9月6日 #

RichTextBox技巧之插入图片（转载）
'Inserts the picture at the current insertion point
Public Function InsertPicture(RTB As RichTextBox, pic As StdPicture)
Dim strRTFall As String
Dim lStart As Long
    With RTB
        .SelText = Chr(&H9D) & .SelText & Chr(&H81)
        strRTFall = .TextRTF
        strRTFall = Replace(strRTFall, "\'9d", PictureToRTF(pic))
        .TextRTF = strRTFall
        'position cursor past new insertion
        lStart = .Find(Chr(&H81))
        strRTFall = Replace(strRTFall, "\'81", "")
        .TextRTF = strRTFall
        .SelStart = lStart
    End With
End Function

PictureToRTF方法：
Public Function PictureToRTF(pic As StdPicture) As String
    Dim hMetaDC As Long, hMeta As Long, hPicDC As Long, hOldBmp As Long
    Dim Bmp As BITMAP, Sz As Size, Pt As POINTAPI
    Dim sTempFile As String, screenDC As Long
    Dim headerStr As String, retStr As String, byteStr As String
    Dim ByteArr() As Byte, nBytes As Long
    Dim fn As Long, i As Long, j As Long

    sTempFile = App.Path & "\~pic" & ((Rnd * 1000000) + 1000000) \ 1 & ".tmp"  'some temprory file
    If Dir(sTempFile) <> "" Then Kill sTempFile
    
    'Create a metafile which is a collection of structures that store a
    'picture in a device-independent format.
    hMetaDC = CreateMetaFile(sTempFile)
    
    'set size of Metafile window
    SetMapMode hMetaDC, MM_ANISOTROPIC
    SetWindowOrgEx hMetaDC, 0, 0, Pt
    GetObject pic.Handle, Len(Bmp), Bmp
    SetWindowExtEx hMetaDC, Bmp.Width, Bmp.Height, Sz
    'save sate for later retrieval
    SaveDC hMetaDC
    
    'get DC compatible to screen
    screenDC = GetDC(0)
    hPicDC = CreateCompatibleDC(screenDC)
    ReleaseDC 0, screenDC
    
    'set out picture as new DC picture
    hOldBmp = SelectObject(hPicDC, pic.Handle)
    
    'copy our picture to metafile
    BitBlt hMetaDC, 0, 0, Bmp.Width, Bmp.Height, hPicDC, 0, 0, vbSrcCopy
    
    'cleanup - close metafile
    SelectObject hPicDC, hOldBmp
    DeleteDC hPicDC
    DeleteObject hOldBmp
    'retrieve saved state
    RestoreDC hMetaDC, True
    hMeta = CloseMetaFile(hMetaDC)
    DeleteMetaFile hMeta
    
    'header to string we want to insert
    headerStr = "{\pict\wmetafile8" & _
                "\picw" & pic.Width & "\pich" & pic.Height & _
                "\picwgoal" & Bmp.Width * Screen.TwipsPerPixelX & _
                "\pichgoal" & Bmp.Height * Screen.TwipsPerPixelY & _
                ""
        
    'read metafile from disk into byte array
    nBytes = FileLen(sTempFile)
    ReDim ByteArr(1 To nBytes)
    fn = FreeFile()
    Open sTempFile For Binary Access Read As #fn
    Get #fn, , ByteArr
    Close #fn
    Dim nlines As Long
        
    'turn each byte into two char hex value
    i = 0
    byteStr = ""
    Do
        byteStr = byteStr & vbCrLf
        For j = 1 To 39
            i = i + 1
            If i > nBytes Then Exit For
            byteStr = byteStr & Hex00(ByteArr(i))
        Next j
    Loop While i < nBytes
    
    'string we will be inserting
    retStr = headerStr & LCase(byteStr) & vbCrLf & "}"
    PictureToRTF = retStr
    
    'remove temp metafile
    Kill sTempFile

End Function

'adds leading zero to hex value if needed.
Public Function Hex00(icolor As Byte) As String
    Hex00 = Right("0" & Hex(icolor), 2)
End Function

posted @ 2006-09-06 17:20 陈锐 阅读(529) | 评论 (0) | 编辑

RichTextBox技巧之插入表格（转载）

Properties - all sizes are in twips
 xLeft - Position of the left edge of the table
 isCentered - Set to True to center the table
 Rows - Sets or returns the number of rows in the table
 Columns - Sets or returns the number of columns in the table
 Row - An Array of Rows (1 to Rows)
 Column - An Array of columns (1 to Columns)
  Column(i).xWidth - Width of the ith column
 Cell - A 2-d Array of Cells (1 to Rows, 1 to Columns)
  Cell(r, c).Contents - Sets or returns the contents of the cell

Methods
 InsertTable(RTB As RichTextBox) - Inserts the table into the RichTextBox
                         at the currrent cursor position.

代码下载地址：
http://www.applevb.com/RTFtable.zip

使用范例：

Option Explicit

Dim RTFtable As clsRTFtable
Private Declare Function LockWindowUpdate Lib "user32" ( _
    ByVal hwndLock As Long _
) As Long

Private Sub Command1_Click()
  Dim i As Integer
  Set RTFtable = New clsRTFtable
  'stop flicker
  Call LockWindowUpdate(RichTextBox1.hWnd)
  
  For i = 1 To 5
  With RTFtable
    'set the size of the table
    .Columns = 3
    .Rows = 2
    'fill the cells
    'Row 1
    .Cell(1, 1).Contents = "Row 1"
    .Cell(1, 2).Contents = "Column2"
    .Cell(1, 3).Contents = "Column3"

    'Row 2
    .Cell(2, 1).Contents = "Row2"
    .Cell(2, 2).Contents = "R2C2"
    .Cell(2, 3).Contents = "R2C3"
    'do we want to center it on the page?
    .isCentered = True
    
    'insert the table at the current cursor postion
    .InsertTable RichTextBox1
  End With
  Next i
    Call LockWindowUpdate(0)

End Sub
posted @ 2006-09-06 17:17 陈锐 阅读(616) | 评论 (0) | 编辑

RichTextBox技巧之插入上标和下标（转载）
Public Sub SetSubScript(RTB As RichTextBox)
Dim iPos As Long
Dim strRTF As String
        With RTB
        If .SelCharOffset >= 0 Then
        'subscript the current selection
            iPos = .SelStart
            .SelText = Chr(&H9D) & .SelText & Chr(&H81)
            strRTF = Replace(.TextRTF, "\'9d", "\sub\dn2 ")
            .TextRTF = Replace(strRTF, "\'81", "\nosupersub\up0 ")
            .SelStart = iPos
        Else 'turn off subscripting
            .SelText = Chr(&H9D) & .SelText
            strRTF = .TextRTF
            .TextRTF = Replace(strRTF, "\'9d", "\nosupersub\up0 ", , 1)
        End If
        End With
End Sub

Public Sub SetSuperScript(RTB As RichTextBox)
'add tags \super\up1 and \nosupersub\up0
Dim iPos As Long
Dim strRTF As String
      With RTB
        iPos = .SelStart
        If RTB.SelCharOffset <= 0 Then
        'superscript the current selection
            .SelText = Chr(&H9D) & .SelText & Chr(&H80)
            strRTF = Replace(.TextRTF, "\'9d", "\super\up2 ")
            .TextRTF = Replace(strRTF, "\'81", "\nosupersub\up0 ")
        Else 'turn off
            .SelText = Chr(&H9D) & .SelText
            strRTF = .TextRTF
            .TextRTF = Replace(strRTF, "\'9d", "\nosupersub\up0 ", , 1)
        End If
        .SelStart = iPos
       End With
End Sub
posted @ 2006-09-06 17:10 陈锐 阅读(207) | 评论 (0) | 编辑

RichTextBox技巧之显示自定义高亮显示（转载）
Public Sub HighLight(RTB As RichTextBox, lColor As Long)
'add new color to color table
'add tags \highlight# and \highlight0