真氣人，努力了一個多月的案子飛了
唉。。。。景氣真的有這麼壞嗎？
搶搶搶，他媽的搶屁呀
真的是黑馬還是官商勾結？
讓我忙的機會少了一個
殘念
現在連敲門磚都飛了
拿啥敲門
意思是我的修煉還不夠嗎？
這種小案子也要搶。。。。
更氣人的是
我們竟然會輸
馬的
丟人
氣人
唉。。。。。
加薪又很遠了....
2008年12月11日 星期四
vb.net 動態call form
Private Sub ShowForm(ByVal FormName As String)
Dim ProjectName As String =
Reflection.Assembly.GetExecutingAssembly.GetName.Name
Try
Dim tyOfStringVariable As Type = Type.GetType(ProjectName & "." &
FormName)
Dim frmObject As Object = Activator.CreateInstance(tyOfStringVariable)
DirectCast(frmObject, Form).StartPosition =
FormStartPosition.CenterParent
DirectCast(frmObject, Form).ShowDialog()
Catch ex As Exception
' TODO
End Try
End Sub
Dim ProjectName As String =
Reflection.Assembly.GetExecutingAssembly.GetName.Name
Try
Dim tyOfStringVariable As Type = Type.GetType(ProjectName & "." &
FormName)
Dim frmObject As Object = Activator.CreateInstance(tyOfStringVariable)
DirectCast(frmObject, Form).StartPosition =
FormStartPosition.CenterParent
DirectCast(frmObject, Form).ShowDialog()
Catch ex As Exception
' TODO
End Try
End Sub
2008年12月2日 星期二
vb.net ->word
Public Class WordOpLib
Private oWordApplic As Word.Application
Private oDocument As Word.Document
Private oRange As Word.Range
Private oSelection As Word.Selection
Public Sub New()
'啟動com word介面
oWordApplic = New Word.Application
oWordApplic.Visible = True
End Sub
'設置選定文本
Public Sub SetRange(ByVal para As Integer)
oRange = oDocument.Paragraphs(para).Range
oRange.Select()
End Sub
Public Sub SetRange(ByVal para As Integer, ByVal sent As Integer)
oRange = oDocument.Paragraphs(para).Range.Sentences(sent)
oRange.Select()
End Sub
Public Sub SetRange(ByVal startpoint As Integer, ByVal endpoint As Integer, ByVal flag As Boolean)
If flag = True Then
oRange = oDocument.Range(startpoint, endpoint)
oRange.Select()
Else
End If
End Sub
'生成空的新文檔
Public Sub NewDocument()
Dim missing = System.Reflection.Missing.Value
Dim isVisible As Boolean = True
oDocument = oWordApplic.Documents.Add(missing, missing, missing, missing)
oDocument.Activate()
End Sub
'使用範本生成新文檔
Public Sub NewDocWithModel(ByVal FileName As String)
Dim missing = System.Reflection.Missing.Value
Dim isVisible As Boolean = True
Dim strName As String
strName = FileName
oDocument = oWordApplic.Documents.Add(strName, missing, missing, isVisible)
oDocument.Activate()
End Sub
'打開已有文檔
Public Sub OpenFile(ByVal FileName As String)
Dim strName As String
Dim isReadOnly As Boolean
Dim isVisible As Boolean
Dim missing = System.Reflection.Missing.Value
strName = FileName
isReadOnly = False
isVisible = True
oDocument = oWordApplic.Documents.Open(strName, missing, isReadOnly, missing, missing, missing, missing, missing, missing, missing, missing, isVisible, missing, missing, missing, missing)
oDocument.Activate()
End Sub
Public Sub OpenFile(ByVal FileName As String, ByVal isReadOnly As Boolean)
Dim strName As String
Dim isVisible As Boolean
Dim missing = System.Reflection.Missing.Value
strName = FileName
isVisible = True
oDocument = oWordApplic.Documents.Open(strName, missing, isReadOnly, missing, missing, missing, missing, missing, missing, missing, missing, isVisible, missing, missing, missing, missing)
oDocument.Activate()
End Sub
'退出Word
Public Sub Quit()
Dim missing = System.Reflection.Missing.Value
oWordApplic.Quit()
System.Runtime.InteropServices.Marshal.ReleaseComObject(oWordApplic)
oWordApplic = Nothing
End Sub
'關閉所有打開的文檔
Public Sub CloseAllDocuments()
oWordApplic.Documents.Close(Word.WdSaveOptions.wdDoNotSaveChanges)
End Sub
'關閉當前的文檔
Public Sub CloseCurrentDocument()
oDocument.Close(Word.WdSaveOptions.wdDoNotSaveChanges)
End Sub
'保存當前文檔
Public Sub Save()
Try
oDocument.Save()
Catch
MsgBox(Err.Description)
End Try
End Sub
'另存為文檔
Public Sub SaveAs(ByVal FileName As String)
Dim strName As String
Dim missing = System.Reflection.Missing.Value
strName = FileName
oDocument.SaveAs(strName, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing)
End Sub
'保存為Html檔
Public Sub SaveAsHtml(ByVal FileName As String)
Dim missing = System.Reflection.Missing.Value
Dim strName As String
strName = FileName
Dim format = CInt(Word.WdSaveFormat.wdFormatHTML)
oDocument.SaveAs(strName, format, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing)
End Sub
'插入文本
Public Sub InsertText(ByVal text As String)
oWordApplic.Selection.TypeText(text)
End Sub
'插入一個空行
Public Sub InsertLineBreak()
oWordApplic.Selection.TypeParagraph()
End Sub
'插入指定行數的空行
Public Sub InsertLineBreak(ByVal lines As Integer)
Dim i As Integer
For i = 1 To lines
oWordApplic.Selection.TypeParagraph()
Next
End Sub
'插入表格
Public Sub InsertTable(ByRef table As DataTable)
Dim oTable As Word.Table
Dim rowIndex, colIndex, NumRows, NumColumns As Integer
rowIndex = 1
colIndex = 0
NumRows = table.Rows.Count + 1
NumColumns = table.Columns.Count
oTable = oDocument.Tables.Add(oWordApplic.Selection.Range(), NumRows, NumColumns)
'初始化列
Dim Row As DataRow
Dim Col As DataColumn
For Each Col In table.Columns
colIndex = colIndex + 1
oTable.Cell(1, colIndex).Range.InsertAfter(Col.ColumnName)
Next
'將行添入表格
For Each Row In table.Rows
rowIndex = rowIndex + 1
colIndex = 0
For Each Col In table.Columns
colIndex = colIndex + 1
oTable.Cell(rowIndex, colIndex).Range.InsertAfter(Row(Col.ColumnName))
Next
Next
oTable.AllowAutoFit = True
oTable.ApplyStyleFirstColumn = True
oTable.ApplyStyleHeadingRows = True
End Sub
'設置對齊
Public Sub SetAlignment(ByVal strType As String)
Select Case strType
Case "center"
oWordApplic.Selection.ParagraphFormat.Alignment = Word.WdParagraphAlignment.wdAlignParagraphCenter
Case "left"
oWordApplic.Selection.ParagraphFormat.Alignment = Word.WdParagraphAlignment.wdAlignParagraphLeft
Case "right"
oWordApplic.Selection.ParagraphFormat.Alignment = Word.WdParagraphAlignment.wdAlignParagraphRight
Case "justify"
oWordApplic.Selection.ParagraphFormat.Alignment = Word.WdParagraphAlignment.wdAlignParagraphJustify
End Select
End Sub
'設置字體
Public Sub SetStyle(ByVal strFont As String)
Select Case strFont
Case "bold"
oWordApplic.Selection.Font.Bold = 1
Case "italic"
oWordApplic.Selection.Font.Italic = 1
Case "underlined"
oWordApplic.Selection.Font.Subscript = 1
End Select
End Sub
'取消字體風格
Public Sub DissableStyle()
oWordApplic.Selection.Font.Bold = 0
oWordApplic.Selection.Font.Italic = 0
oWordApplic.Selection.Font.Subscript = 0
End Sub
'設置字體字型大小
Public Sub SetFontSize(ByVal nSize As Integer)
oWordApplic.Selection.Font.Size = nSize
End Sub
'跳過本頁
Public Sub InsertPageBreak()
Dim pBreak As Integer
pBreak = CInt(Word.WdBreakType.wdPageBreak)
oWordApplic.Selection.InsertBreak(pBreak)
End Sub
'轉到書簽
Public Sub GotoBookMark(ByVal strBookMark As String)
Dim missing = System.Reflection.Missing.Value
Dim BookMark = CInt(Word.WdGoToItem.wdGoToBookmark)
oWordApplic.Selection.GoTo(BookMark, missing, missing, strBookMark)
End Sub
'判斷書簽是否存在
Public Function BookMarkExist(ByVal strBookMark As String) As Boolean
Dim Exist As Boolean
Exist = oDocument.Bookmarks.Exists(strBookMark)
Return Exist
End Function
'轉到文檔結尾
Public Sub GotoTheEnd()
Dim missing = System.Reflection.Missing.Value
Dim unit = Word.WdUnits.wdStory
oWordApplic.Selection.EndKey(unit, missing)
End Sub
'轉到文檔開頭
Public Sub GotoTheBegining()
Dim missing = System.Reflection.Missing.Value
Dim unit = Word.WdUnits.wdStory
oWordApplic.Selection.HomeKey(unit, missing)
End Sub
'轉到表格
Public Sub GotoTheTable(ByVal ntable As Integer)
'Dim missing = System.Reflection.Missing.Value
'Dim what = Word.WdGoToItem.wdGoToTable
'Dim which = Word.WdGoToDirection.wdGoToFirst
'Dim count = ntable
'oWordApplic.Selection.GoTo(what, which, count, missing)
'oWordApplic.Selection.ClearFormatting()
'oWordApplic.Selection.Text = ""
oRange = oDocument.Tables(ntable).Cell(1, 1).Range
oRange.Select()
End Sub
'轉到表格的某個儲存格
Public Sub GotoTableCell(ByVal ntable As Integer, ByVal nRow As Integer, ByVal nColumn As Integer)
oRange = oDocument.Tables(ntable).Cell(nRow, nColumn).Range
oRange.Select()
End Sub
'表格中轉到右面的儲存格
Public Sub GotoRightCell()
Dim missing = System.Reflection.Missing.Value
Dim direction = Word.WdUnits.wdCell
oWordApplic.Selection.MoveRight(direction, missing, missing)
End Sub
'表格中轉到左面的儲存格
Public Sub GotoLeftCell()
Dim missing = System.Reflection.Missing.Value
Dim direction = Word.WdUnits.wdCell
oWordApplic.Selection.MoveLeft(direction, missing, missing)
End Sub
'表格中轉到下麵的儲存格
Public Sub GotoDownCell()
Dim missing = System.Reflection.Missing.Value
Dim direction = Word.WdUnits.wdCell
oWordApplic.Selection.MoveDown(direction, missing, missing)
End Sub
'表格中轉到上面的儲存格
Public Sub GotoUpCell()
Dim missing = System.Reflection.Missing.Value
Dim direction = Word.WdUnits.wdCell
oWordApplic.Selection.MoveUp(direction, missing, missing)
End Sub
'插入圖片
Public Sub InsertPic(ByVal FileName As String)
Dim missing = System.Reflection.Missing.Value
oWordApplic.Selection.InlineShapes.AddPicture(FileName, False, True, missing)
End Sub
End Class
Private oWordApplic As Word.Application
Private oDocument As Word.Document
Private oRange As Word.Range
Private oSelection As Word.Selection
Public Sub New()
'啟動com word介面
oWordApplic = New Word.Application
oWordApplic.Visible = True
End Sub
'設置選定文本
Public Sub SetRange(ByVal para As Integer)
oRange = oDocument.Paragraphs(para).Range
oRange.Select()
End Sub
Public Sub SetRange(ByVal para As Integer, ByVal sent As Integer)
oRange = oDocument.Paragraphs(para).Range.Sentences(sent)
oRange.Select()
End Sub
Public Sub SetRange(ByVal startpoint As Integer, ByVal endpoint As Integer, ByVal flag As Boolean)
If flag = True Then
oRange = oDocument.Range(startpoint, endpoint)
oRange.Select()
Else
End If
End Sub
'生成空的新文檔
Public Sub NewDocument()
Dim missing = System.Reflection.Missing.Value
Dim isVisible As Boolean = True
oDocument = oWordApplic.Documents.Add(missing, missing, missing, missing)
oDocument.Activate()
End Sub
'使用範本生成新文檔
Public Sub NewDocWithModel(ByVal FileName As String)
Dim missing = System.Reflection.Missing.Value
Dim isVisible As Boolean = True
Dim strName As String
strName = FileName
oDocument = oWordApplic.Documents.Add(strName, missing, missing, isVisible)
oDocument.Activate()
End Sub
'打開已有文檔
Public Sub OpenFile(ByVal FileName As String)
Dim strName As String
Dim isReadOnly As Boolean
Dim isVisible As Boolean
Dim missing = System.Reflection.Missing.Value
strName = FileName
isReadOnly = False
isVisible = True
oDocument = oWordApplic.Documents.Open(strName, missing, isReadOnly, missing, missing, missing, missing, missing, missing, missing, missing, isVisible, missing, missing, missing, missing)
oDocument.Activate()
End Sub
Public Sub OpenFile(ByVal FileName As String, ByVal isReadOnly As Boolean)
Dim strName As String
Dim isVisible As Boolean
Dim missing = System.Reflection.Missing.Value
strName = FileName
isVisible = True
oDocument = oWordApplic.Documents.Open(strName, missing, isReadOnly, missing, missing, missing, missing, missing, missing, missing, missing, isVisible, missing, missing, missing, missing)
oDocument.Activate()
End Sub
'退出Word
Public Sub Quit()
Dim missing = System.Reflection.Missing.Value
oWordApplic.Quit()
System.Runtime.InteropServices.Marshal.ReleaseComObject(oWordApplic)
oWordApplic = Nothing
End Sub
'關閉所有打開的文檔
Public Sub CloseAllDocuments()
oWordApplic.Documents.Close(Word.WdSaveOptions.wdDoNotSaveChanges)
End Sub
'關閉當前的文檔
Public Sub CloseCurrentDocument()
oDocument.Close(Word.WdSaveOptions.wdDoNotSaveChanges)
End Sub
'保存當前文檔
Public Sub Save()
Try
oDocument.Save()
Catch
MsgBox(Err.Description)
End Try
End Sub
'另存為文檔
Public Sub SaveAs(ByVal FileName As String)
Dim strName As String
Dim missing = System.Reflection.Missing.Value
strName = FileName
oDocument.SaveAs(strName, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing)
End Sub
'保存為Html檔
Public Sub SaveAsHtml(ByVal FileName As String)
Dim missing = System.Reflection.Missing.Value
Dim strName As String
strName = FileName
Dim format = CInt(Word.WdSaveFormat.wdFormatHTML)
oDocument.SaveAs(strName, format, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing)
End Sub
'插入文本
Public Sub InsertText(ByVal text As String)
oWordApplic.Selection.TypeText(text)
End Sub
'插入一個空行
Public Sub InsertLineBreak()
oWordApplic.Selection.TypeParagraph()
End Sub
'插入指定行數的空行
Public Sub InsertLineBreak(ByVal lines As Integer)
Dim i As Integer
For i = 1 To lines
oWordApplic.Selection.TypeParagraph()
Next
End Sub
'插入表格
Public Sub InsertTable(ByRef table As DataTable)
Dim oTable As Word.Table
Dim rowIndex, colIndex, NumRows, NumColumns As Integer
rowIndex = 1
colIndex = 0
NumRows = table.Rows.Count + 1
NumColumns = table.Columns.Count
oTable = oDocument.Tables.Add(oWordApplic.Selection.Range(), NumRows, NumColumns)
'初始化列
Dim Row As DataRow
Dim Col As DataColumn
For Each Col In table.Columns
colIndex = colIndex + 1
oTable.Cell(1, colIndex).Range.InsertAfter(Col.ColumnName)
Next
'將行添入表格
For Each Row In table.Rows
rowIndex = rowIndex + 1
colIndex = 0
For Each Col In table.Columns
colIndex = colIndex + 1
oTable.Cell(rowIndex, colIndex).Range.InsertAfter(Row(Col.ColumnName))
Next
Next
oTable.AllowAutoFit = True
oTable.ApplyStyleFirstColumn = True
oTable.ApplyStyleHeadingRows = True
End Sub
'設置對齊
Public Sub SetAlignment(ByVal strType As String)
Select Case strType
Case "center"
oWordApplic.Selection.ParagraphFormat.Alignment = Word.WdParagraphAlignment.wdAlignParagraphCenter
Case "left"
oWordApplic.Selection.ParagraphFormat.Alignment = Word.WdParagraphAlignment.wdAlignParagraphLeft
Case "right"
oWordApplic.Selection.ParagraphFormat.Alignment = Word.WdParagraphAlignment.wdAlignParagraphRight
Case "justify"
oWordApplic.Selection.ParagraphFormat.Alignment = Word.WdParagraphAlignment.wdAlignParagraphJustify
End Select
End Sub
'設置字體
Public Sub SetStyle(ByVal strFont As String)
Select Case strFont
Case "bold"
oWordApplic.Selection.Font.Bold = 1
Case "italic"
oWordApplic.Selection.Font.Italic = 1
Case "underlined"
oWordApplic.Selection.Font.Subscript = 1
End Select
End Sub
'取消字體風格
Public Sub DissableStyle()
oWordApplic.Selection.Font.Bold = 0
oWordApplic.Selection.Font.Italic = 0
oWordApplic.Selection.Font.Subscript = 0
End Sub
'設置字體字型大小
Public Sub SetFontSize(ByVal nSize As Integer)
oWordApplic.Selection.Font.Size = nSize
End Sub
'跳過本頁
Public Sub InsertPageBreak()
Dim pBreak As Integer
pBreak = CInt(Word.WdBreakType.wdPageBreak)
oWordApplic.Selection.InsertBreak(pBreak)
End Sub
'轉到書簽
Public Sub GotoBookMark(ByVal strBookMark As String)
Dim missing = System.Reflection.Missing.Value
Dim BookMark = CInt(Word.WdGoToItem.wdGoToBookmark)
oWordApplic.Selection.GoTo(BookMark, missing, missing, strBookMark)
End Sub
'判斷書簽是否存在
Public Function BookMarkExist(ByVal strBookMark As String) As Boolean
Dim Exist As Boolean
Exist = oDocument.Bookmarks.Exists(strBookMark)
Return Exist
End Function
'轉到文檔結尾
Public Sub GotoTheEnd()
Dim missing = System.Reflection.Missing.Value
Dim unit = Word.WdUnits.wdStory
oWordApplic.Selection.EndKey(unit, missing)
End Sub
'轉到文檔開頭
Public Sub GotoTheBegining()
Dim missing = System.Reflection.Missing.Value
Dim unit = Word.WdUnits.wdStory
oWordApplic.Selection.HomeKey(unit, missing)
End Sub
'轉到表格
Public Sub GotoTheTable(ByVal ntable As Integer)
'Dim missing = System.Reflection.Missing.Value
'Dim what = Word.WdGoToItem.wdGoToTable
'Dim which = Word.WdGoToDirection.wdGoToFirst
'Dim count = ntable
'oWordApplic.Selection.GoTo(what, which, count, missing)
'oWordApplic.Selection.ClearFormatting()
'oWordApplic.Selection.Text = ""
oRange = oDocument.Tables(ntable).Cell(1, 1).Range
oRange.Select()
End Sub
'轉到表格的某個儲存格
Public Sub GotoTableCell(ByVal ntable As Integer, ByVal nRow As Integer, ByVal nColumn As Integer)
oRange = oDocument.Tables(ntable).Cell(nRow, nColumn).Range
oRange.Select()
End Sub
'表格中轉到右面的儲存格
Public Sub GotoRightCell()
Dim missing = System.Reflection.Missing.Value
Dim direction = Word.WdUnits.wdCell
oWordApplic.Selection.MoveRight(direction, missing, missing)
End Sub
'表格中轉到左面的儲存格
Public Sub GotoLeftCell()
Dim missing = System.Reflection.Missing.Value
Dim direction = Word.WdUnits.wdCell
oWordApplic.Selection.MoveLeft(direction, missing, missing)
End Sub
'表格中轉到下麵的儲存格
Public Sub GotoDownCell()
Dim missing = System.Reflection.Missing.Value
Dim direction = Word.WdUnits.wdCell
oWordApplic.Selection.MoveDown(direction, missing, missing)
End Sub
'表格中轉到上面的儲存格
Public Sub GotoUpCell()
Dim missing = System.Reflection.Missing.Value
Dim direction = Word.WdUnits.wdCell
oWordApplic.Selection.MoveUp(direction, missing, missing)
End Sub
'插入圖片
Public Sub InsertPic(ByVal FileName As String)
Dim missing = System.Reflection.Missing.Value
oWordApplic.Selection.InlineShapes.AddPicture(FileName, False, True, missing)
End Sub
End Class
2008年12月1日 星期一
在word 裡面插入統計圖表
'方法一：用word內建函數
Imports System.Runtime.InteropServices
Imports Microsoft.Office.Interop
Imports owc11 = Microsoft.Office.Interop.Owc11
Dim oWord As Word.Application
Dim oDoc As Word.Document
Dim oRng As Word.Range
Dim oShape As Word.InlineShape
Dim oChart As Object
oShape = oDoc.Bookmarks.Item("\endofdoc").Range.InlineShapes.AddOLEObject( _
ClassType:="MSGraph.Chart", FileName _
:="", LinkToFile:=False, DisplayAsIcon:=False)
oChart = oShape.OLEFormat.Object
oChart.charttype = 5 'xlLine = 4
'都沒有=立體圖(長條圖) 1=一般 4=線圖 5=圓餅圖
oChart.Application.Update()
oChart.Application.Quit()
'If desired, you can proceed from here using the Microsoft Graph
'Object model on the oChart object to make additional changes to the
'chart.
oShape.Width = oWord.InchesToPoints(6.25)
oShape.Height = oWord.InchesToPoints(3.57)
'方法2：用vb.net(word) 內建控制項繪製，轉成圖片，插入word文件
'ACS=AxCharSpace
Dim oWord As New Word.Application
Dim oDoc As Word.Document
Dim oRng As Word.Range
Dim ii As Integer
Dim rowIndex, colIndex As Integer
Dim missing = System.Reflection.Missing.Value
Dim aX, aY
ReDim aX(5)
ReDim aY(5)
Dim DS As New DataSet
DS.Tables.Add()
DS.Tables(0).Columns.Add("姓名")
DS.Tables(0).Columns.Add("成績")
DS.Tables(0).Rows.Add()
DS.Tables(0).Rows(DS.Tables(0).Rows.Count - 1).Item("姓名") = "陳小邦"
DS.Tables(0).Rows(DS.Tables(0).Rows.Count - 1).Item("成績") = "93"
DS.Tables(0).Rows.Add()
DS.Tables(0).Rows(DS.Tables(0).Rows.Count - 1).Item("姓名") = "張小千"
DS.Tables(0).Rows(DS.Tables(0).Rows.Count - 1).Item("成績") = "66"
DS.Tables(0).Rows.Add()
DS.Tables(0).Rows(DS.Tables(0).Rows.Count - 1).Item("姓名") = "林小狗"
DS.Tables(0).Rows(DS.Tables(0).Rows.Count - 1).Item("成績") = "89"
DS.Tables(0).Rows.Add()
DS.Tables(0).Rows(DS.Tables(0).Rows.Count - 1).Item("姓名") = "王宜靜"
DS.Tables(0).Rows(DS.Tables(0).Rows.Count - 1).Item("成績") = "99"
DS.Tables(0).Rows.Add()
DS.Tables(0).Rows(DS.Tables(0).Rows.Count - 1).Item("姓名") = "張大飛"
DS.Tables(0).Rows(DS.Tables(0).Rows.Count - 1).Item("成績") = "78"
DS.Tables(0).Rows.Add()
DS.Tables(0).Rows(DS.Tables(0).Rows.Count - 1).Item("姓名") = "桶一針"
DS.Tables(0).Rows(DS.Tables(0).Rows.Count - 1).Item("成績") = "79"
For ii = 0 To DS.Tables(0).Rows.Count - 1
aX(ii) = DS.Tables(0).Rows(ii).Item("姓名")
aY(ii) = DS.Tables(0).Rows(ii).Item("成績")
Next
oRng = oDoc.Bookmarks.Item("\endofdoc").Range
oRng.InsertParagraphAfter()
Dim Chart1 As Owc11.ChChart
Chart1 = ChartSpace1.Charts.Add() '在ChartSpace1繪圖空間內建一個新圖表(繒圖區)
Dim Chart1_Series1 As Owc11.ChSeries
'宣告資料列...
Chart1_Series1 = Chart1.SeriesCollection.Add(0) '在Chart1圖表中加一個資料列
Chart1_Series1.Type = Owc11.ChartChartTypeEnum.chChartTypeBarClustered
'命名資料系列（名稱將在圖例中顯示出來）
Chart1_Series1.SetData(Owc11.ChartDimensionsEnum.chDimSeriesNames, Owc11.ChartSpecialDataSourcesEnum.chDataLiteral, "成績")
'將資料組中的資料填入圖表
Chart1_Series1.SetData(Owc11.ChartDimensionsEnum.chDimCategories, Owc11.ChartSpecialDataSourcesEnum.chDataLiteral, aX) '姓名軸
Chart1_Series1.SetData(Owc11.ChartDimensionsEnum.chDimValues, Owc11.ChartSpecialDataSourcesEnum.chDataLiteral, aY) '成績軸
Chart1_Series1.SetData(ChartDimensionsEnum.chDimHighValues, Owc11.ChartSpecialDataSourcesEnum.chDataLiteral, 100)
'匯出圖片
ACS.ExportPicture(Application.StartupPath & "\1.GIF", "GIF", ACS.Width, ACS.Height)
'尋找文件結尾
missing = System.Reflection.Missing.Value
Dim unit = Word.WdUnits.wdStory
oWord.Selection.EndKey(unit, missing)
oWord.Selection.InlineShapes.AddPicture(Application.StartupPath & "\1.GIF", False, True, missing)
'Add text after the chart.
oRng.InsertParagraphAfter()
oDoc.SaveAs(Application.StartupPath & "\1.doc")
oDoc.Close(True)
oWord.Quit(True)
oDoc = Nothing
oWord = Nothing
Imports System.Runtime.InteropServices
Imports Microsoft.Office.Interop
Imports owc11 = Microsoft.Office.Interop.Owc11
Dim oWord As Word.Application
Dim oDoc As Word.Document
Dim oRng As Word.Range
Dim oShape As Word.InlineShape
Dim oChart As Object
oShape = oDoc.Bookmarks.Item("\endofdoc").Range.InlineShapes.AddOLEObject( _
ClassType:="MSGraph.Chart", FileName _
:="", LinkToFile:=False, DisplayAsIcon:=False)
oChart = oShape.OLEFormat.Object
oChart.charttype = 5 'xlLine = 4
'都沒有=立體圖(長條圖) 1=一般 4=線圖 5=圓餅圖
oChart.Application.Update()
oChart.Application.Quit()
'If desired, you can proceed from here using the Microsoft Graph
'Object model on the oChart object to make additional changes to the
'chart.
oShape.Width = oWord.InchesToPoints(6.25)
oShape.Height = oWord.InchesToPoints(3.57)
'方法2：用vb.net(word) 內建控制項繪製，轉成圖片，插入word文件
'ACS=AxCharSpace
Dim oWord As New Word.Application
Dim oDoc As Word.Document
Dim oRng As Word.Range
Dim ii As Integer
Dim rowIndex, colIndex As Integer
Dim missing = System.Reflection.Missing.Value
Dim aX, aY
ReDim aX(5)
ReDim aY(5)
Dim DS As New DataSet
DS.Tables.Add()
DS.Tables(0).Columns.Add("姓名")
DS.Tables(0).Columns.Add("成績")
DS.Tables(0).Rows.Add()
DS.Tables(0).Rows(DS.Tables(0).Rows.Count - 1).Item("姓名") = "陳小邦"
DS.Tables(0).Rows(DS.Tables(0).Rows.Count - 1).Item("成績") = "93"
DS.Tables(0).Rows.Add()
DS.Tables(0).Rows(DS.Tables(0).Rows.Count - 1).Item("姓名") = "張小千"
DS.Tables(0).Rows(DS.Tables(0).Rows.Count - 1).Item("成績") = "66"
DS.Tables(0).Rows.Add()
DS.Tables(0).Rows(DS.Tables(0).Rows.Count - 1).Item("姓名") = "林小狗"
DS.Tables(0).Rows(DS.Tables(0).Rows.Count - 1).Item("成績") = "89"
DS.Tables(0).Rows.Add()
DS.Tables(0).Rows(DS.Tables(0).Rows.Count - 1).Item("姓名") = "王宜靜"
DS.Tables(0).Rows(DS.Tables(0).Rows.Count - 1).Item("成績") = "99"
DS.Tables(0).Rows.Add()
DS.Tables(0).Rows(DS.Tables(0).Rows.Count - 1).Item("姓名") = "張大飛"
DS.Tables(0).Rows(DS.Tables(0).Rows.Count - 1).Item("成績") = "78"
DS.Tables(0).Rows.Add()
DS.Tables(0).Rows(DS.Tables(0).Rows.Count - 1).Item("姓名") = "桶一針"
DS.Tables(0).Rows(DS.Tables(0).Rows.Count - 1).Item("成績") = "79"
For ii = 0 To DS.Tables(0).Rows.Count - 1
aX(ii) = DS.Tables(0).Rows(ii).Item("姓名")
aY(ii) = DS.Tables(0).Rows(ii).Item("成績")
Next
oRng = oDoc.Bookmarks.Item("\endofdoc").Range
oRng.InsertParagraphAfter()
Dim Chart1 As Owc11.ChChart
Chart1 = ChartSpace1.Charts.Add() '在ChartSpace1繪圖空間內建一個新圖表(繒圖區)
Dim Chart1_Series1 As Owc11.ChSeries
'宣告資料列...
Chart1_Series1 = Chart1.SeriesCollection.Add(0) '在Chart1圖表中加一個資料列
Chart1_Series1.Type = Owc11.ChartChartTypeEnum.chChartTypeBarClustered
'命名資料系列（名稱將在圖例中顯示出來）
Chart1_Series1.SetData(Owc11.ChartDimensionsEnum.chDimSeriesNames, Owc11.ChartSpecialDataSourcesEnum.chDataLiteral, "成績")
'將資料組中的資料填入圖表
Chart1_Series1.SetData(Owc11.ChartDimensionsEnum.chDimCategories, Owc11.ChartSpecialDataSourcesEnum.chDataLiteral, aX) '姓名軸
Chart1_Series1.SetData(Owc11.ChartDimensionsEnum.chDimValues, Owc11.ChartSpecialDataSourcesEnum.chDataLiteral, aY) '成績軸
Chart1_Series1.SetData(ChartDimensionsEnum.chDimHighValues, Owc11.ChartSpecialDataSourcesEnum.chDataLiteral, 100)
'匯出圖片
ACS.ExportPicture(Application.StartupPath & "\1.GIF", "GIF", ACS.Width, ACS.Height)
'尋找文件結尾
missing = System.Reflection.Missing.Value
Dim unit = Word.WdUnits.wdStory
oWord.Selection.EndKey(unit, missing)
oWord.Selection.InlineShapes.AddPicture(Application.StartupPath & "\1.GIF", False, True, missing)
'Add text after the chart.
oRng.InsertParagraphAfter()
oDoc.SaveAs(Application.StartupPath & "\1.doc")
oDoc.Close(True)
oWord.Quit(True)
oDoc = Nothing
oWord = Nothing
2008年11月21日 星期五
vb.net 讀取資料庫的圖片
'方法一，不需寫成檔案即可讀成圖片
Dim V_byte() As Byte
V_byte = DS.Tables(0).Rows(0).Item("pic")
Dim intLength As Integer = UBound(V_byte)
Dim V_stream As New System.IO.MemoryStream(V_byte, 0, intLength)
PictureBox1.Image = Image.FromStream(V_stream)
'方法二，寫成圖片檔
My.Computer.FileSystem.WriteAllBytes(Trim(DS.Tables(0).Rows(0).Item("filename")), DS.Tables(0).Rows(0).Item("pic"), True)
V_image = Image.FromFile(Application.StartupPath & "\" & Trim(DS.Tables(0).Rows(0).Item("filename")), False)
PictureBox1.Image = V_image
Dim V_byte() As Byte
V_byte = DS.Tables(0).Rows(0).Item("pic")
Dim intLength As Integer = UBound(V_byte)
Dim V_stream As New System.IO.MemoryStream(V_byte, 0, intLength)
PictureBox1.Image = Image.FromStream(V_stream)
'方法二，寫成圖片檔
My.Computer.FileSystem.WriteAllBytes(Trim(DS.Tables(0).Rows(0).Item("filename")), DS.Tables(0).Rows(0).Item("pic"), True)
V_image = Image.FromFile(Application.StartupPath & "\" & Trim(DS.Tables(0).Rows(0).Item("filename")), False)
PictureBox1.Image = V_image
2008年11月17日 星期一
2008年11月16日 星期日
vb.net 每天開機自動換桌面
Imports System.Drawing
Imports System.Windows.Forms
Imports System.Drawing.Imaging
Public Class Form1
Private Declare Function SetParam Lib "user32" Alias "SystemParametersInfoA" _
(Optional ByVal uAction As Integer = 20, Optional ByVal uParam As Integer = 0, Optional ByVal lpvParam As String = "", _
Optional ByVal fuWinIni As Integer = &H1) As Integer
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Dim V_Day As Integer
V_Day = Date.Now.DayOfWeek
'MsgBox(V_Day)
SetWallPaper(V_Day & ".jpg", WallpaperStyle.延展)
Me.Close()
End Sub
Public Sub SetWallPaper(ByVal V_file_name As String, Optional ByVal Style As WallpaperStyle = WallpaperStyle.延展)
'Dim ic As New Bitmap(Path)
'ic.Save(Application.StartupPath & "\" & V_file_name, Drawing.Imaging.ImageFormat.Bmp)
'ic.Dispose()
Dim DesktopKey As Microsoft.Win32.RegistryKey = My.Computer.Registry.CurrentUser. _
OpenSubKey("Control Panel", True). _
OpenSubKey("Desktop", True)
'DesktopKey.SetValue("ConvertedWallpaper", Path, Microsoft.Win32.RegistryValueKind.String)
DesktopKey.SetValue("OriginalWallpaper", Application.StartupPath & "\" & V_file_name, Microsoft.Win32.RegistryValueKind.String)
DesktopKey.SetValue("Wallpaper", Application.StartupPath & "\" & V_file_name, Microsoft.Win32.RegistryValueKind.String)
If Style = WallpaperStyle.並排 Then
DesktopKey.SetValue("WallpaperStyle", 0, Microsoft.Win32.RegistryValueKind.String)
DesktopKey.SetValue("TileWallpaper", 1, Microsoft.Win32.RegistryValueKind.String)
ElseIf Style = WallpaperStyle.居中 Then
DesktopKey.SetValue("WallpaperStyle", 0, Microsoft.Win32.RegistryValueKind.String)
DesktopKey.SetValue("TileWallpaper", 0, Microsoft.Win32.RegistryValueKind.String)
ElseIf Style = WallpaperStyle.延展 Then
DesktopKey.SetValue("WallpaperStyle", 2, Microsoft.Win32.RegistryValueKind.String)
DesktopKey.SetValue("TileWallpaper", 0, Microsoft.Win32.RegistryValueKind.String)
End If
'My.Computer.FileSystem.GetFileInfo(Path).LastWriteTime = Now
SetParam(20, 0, Application.StartupPath & "\" & V_file_name)
End Sub
Public Enum WallpaperStyle
居中 = 0
並排 = 1
延展 = 2
End Enum
End Class
Imports System.Windows.Forms
Imports System.Drawing.Imaging
Public Class Form1
Private Declare Function SetParam Lib "user32" Alias "SystemParametersInfoA" _
(Optional ByVal uAction As Integer = 20, Optional ByVal uParam As Integer = 0, Optional ByVal lpvParam As String = "", _
Optional ByVal fuWinIni As Integer = &H1) As Integer
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Dim V_Day As Integer
V_Day = Date.Now.DayOfWeek
'MsgBox(V_Day)
SetWallPaper(V_Day & ".jpg", WallpaperStyle.延展)
Me.Close()
End Sub
Public Sub SetWallPaper(ByVal V_file_name As String, Optional ByVal Style As WallpaperStyle = WallpaperStyle.延展)
'Dim ic As New Bitmap(Path)
'ic.Save(Application.StartupPath & "\" & V_file_name, Drawing.Imaging.ImageFormat.Bmp)
'ic.Dispose()
Dim DesktopKey As Microsoft.Win32.RegistryKey = My.Computer.Registry.CurrentUser. _
OpenSubKey("Control Panel", True). _
OpenSubKey("Desktop", True)
'DesktopKey.SetValue("ConvertedWallpaper", Path, Microsoft.Win32.RegistryValueKind.String)
DesktopKey.SetValue("OriginalWallpaper", Application.StartupPath & "\" & V_file_name, Microsoft.Win32.RegistryValueKind.String)
DesktopKey.SetValue("Wallpaper", Application.StartupPath & "\" & V_file_name, Microsoft.Win32.RegistryValueKind.String)
If Style = WallpaperStyle.並排 Then
DesktopKey.SetValue("WallpaperStyle", 0, Microsoft.Win32.RegistryValueKind.String)
DesktopKey.SetValue("TileWallpaper", 1, Microsoft.Win32.RegistryValueKind.String)
ElseIf Style = WallpaperStyle.居中 Then
DesktopKey.SetValue("WallpaperStyle", 0, Microsoft.Win32.RegistryValueKind.String)
DesktopKey.SetValue("TileWallpaper", 0, Microsoft.Win32.RegistryValueKind.String)
ElseIf Style = WallpaperStyle.延展 Then
DesktopKey.SetValue("WallpaperStyle", 2, Microsoft.Win32.RegistryValueKind.String)
DesktopKey.SetValue("TileWallpaper", 0, Microsoft.Win32.RegistryValueKind.String)
End If
'My.Computer.FileSystem.GetFileInfo(Path).LastWriteTime = Now
SetParam(20, 0, Application.StartupPath & "\" & V_file_name)
End Sub
Public Enum WallpaperStyle
居中 = 0
並排 = 1
延展 = 2
End Enum
End Class
2008年11月12日 星期三
Informix win32版
http://www14.software.ibm.com/webapp/download/preconfig.jsp?id=2005-08-15+14%3A41%3A13.105308R&S_TACT=104CBW71&S_CMP=
2008年11月7日 星期五
Vista home Premium 安裝IIS
Windows Vista Home Premium
start /w pkgmgr /iu:IIS-WebServerRole;IIS-WebServer;IIS-CommonHttpFeatures;IIS-StaticContent;IIS-DefaultDocument;IIS-DirectoryBrowsing;IIS-HttpErrors;IIS-HttpRedirect;IIS-ApplicationDevelopment;IIS-ASPNET;IIS-NetFxExtensibility;IIS-ASP;IIS-CGI;IIS-ISAPIExtensions;IIS-ISAPIFilter;IIS-ServerSideIncludes;IIS-HealthAndDiagnostics;IIS-HttpLogging;IIS-LoggingLibraries;IIS-RequestMonitor;IIS-HttpTracing;IIS-CustomLogging;IIS-Security;IIS-BasicAuthentication;IIS-URLAuthorization;IIS-RequestFiltering;IIS-IPSecurity;IIS-Performance;IIS-HttpCompressionStatic;IIS-HttpCompressionDynamic;IIS-WebServerManagementTools;IIS-ManagementConsole;IIS-ManagementScriptingTools;IIS-ManagementService;IIS-IIS6ManagementCompatibility;IIS-Metabase;IIS-WMICompatibility;IIS-LegacyScripts;IIS-LegacySnapIn;WAS-WindowsActivationService;WAS-ProcessModel;WAS-NetFxEnvironment;WAS-ConfigurationAPI
請注意：
1. 如果您不要安裝完整的 IIS 7，請自行修改上述的指令碼，將不要的元件從指令碼中移除。
2. 安裝完畢之後，可以使用如下的指令碼來檢查是否安裝成功：
echo %errorlevel%
如果回傳的值是 0，那就表示安裝成功了！
2008年10月5日 星期日
SQL server mobile
http://www.microsoft.com/downloads/details.aspx?familyid=38ED2670-A70A-43B3-87F3-7AB67B56CBF2&displaylang=zh-tw
官方下載點
官方下載點
2008年9月29日 星期一
2008年9月27日 星期六
vb.net 讓Datagridview 的Scroll Bar 自動滾動
Dim V_scroll As Integer
V_scroll = DGV_sch.VerticalScrollingOffset / DGV_sch.Rows(1).Height
DGV_sch.FirstDisplayedScrollingRowIndex = V_scroll
'不要亂用笨方法 row.selected=true
'it does not work !! 誤導他人的對岸才用種方法
V_scroll = DGV_sch.VerticalScrollingOffset / DGV_sch.Rows(1).Height
DGV_sch.FirstDisplayedScrollingRowIndex = V_scroll
'不要亂用笨方法 row.selected=true
'it does not work !! 誤導他人的對岸才用種方法
2008年9月25日 星期四
vb.net 跨執行緒使用DGV
Public Class Form1
Dim MainThread As New Threading.Thread(AddressOf MainProcess) '定義新的執行序
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
End Sub
Public Sub MainProcess() '執行序啟動
Dim Ii As Integer
For Ii = 0 To 1200
SetDGV(Ii, DGV)
Threading.Thread.Sleep(200)
Next
End Sub
'跨執行序呼叫元件,label 跟 button
'-------------------button
Public Sub SetDGV(ByVal [text] As String, ByVal DGV1 As DataGridView)
' InvokeRequired required compares the thread ID of the
' calling thread to the thread ID of the creating thread.
' If these threads are different, it returns true.
If DGV1.InvokeRequired Then
Dim d As New SetDGVCallback(AddressOf SetDGV)
DGV1.Invoke(d, New Object() {Convert.ToString([text]), DGV1})
Else
DGV1.Rows.Add()
DGV1.Rows(DGV.Rows.Count - 2).Cells(0).Value = [text]
End If
End Sub
Delegate Sub SetDGVCallback(ByVal [text] As String, ByVal DGV1 As DataGridView)
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
MainThread.Start()
End Sub
End Class
Dim MainThread As New Threading.Thread(AddressOf MainProcess) '定義新的執行序
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
End Sub
Public Sub MainProcess() '執行序啟動
Dim Ii As Integer
For Ii = 0 To 1200
SetDGV(Ii, DGV)
Threading.Thread.Sleep(200)
Next
End Sub
'跨執行序呼叫元件,label 跟 button
'-------------------button
Public Sub SetDGV(ByVal [text] As String, ByVal DGV1 As DataGridView)
' InvokeRequired required compares the thread ID of the
' calling thread to the thread ID of the creating thread.
' If these threads are different, it returns true.
If DGV1.InvokeRequired Then
Dim d As New SetDGVCallback(AddressOf SetDGV)
DGV1.Invoke(d, New Object() {Convert.ToString([text]), DGV1})
Else
DGV1.Rows.Add()
DGV1.Rows(DGV.Rows.Count - 2).Cells(0).Value = [text]
End If
End Sub
Delegate Sub SetDGVCallback(ByVal [text] As String, ByVal DGV1 As DataGridView)
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
MainThread.Start()
End Sub
End Class
2008年9月23日 星期二
JAVA QR CODE 原始碼 (50%自由度)
http://www.javaworld.com.tw/jute/post/view?bid=26&id=137843&sty=1&tpg=1&age=0
時機歹歹，日本人怎麼不寫.net的版本勒....
時機歹歹，日本人怎麼不寫.net的版本勒....
2008年9月22日 星期一
防治病毒感言-kavo
終於有人跳出來敢說可以對附隨身碟病毒
USB病毒讓許多使用者和MIS頭痛不已，因為它防不勝防，殺了又中、中了再殺，無止盡的變種病毒更讓防毒軟體防不勝防。 許多人認為抓不到病毒是防毒軟體的原罪，於是尋求其他的解決方案。但在之下，這些方法真的有效嗎？本文將帶你深入了解USB病毒的危害、手法及防禦之道。
去年，USB病毒的主要目的是竊取線上遊戲的帳號和密碼，針對其目的而言，如果使用者本身沒有玩線上遊戲，這些病毒並不會帶來多大的損失，頂多只是看不到系統的隱藏檔，系統效能被拖慢一些。但在病毒持續變種之下，除了竊取帳號密碼，還會破壞網路裝置（網路中斷）、無法進入安全模式、停用防毒軟體、無法執行某些程式…。當到這個階段，使用者才會感到麻煩大了。
在病毒感染的初期，使用者大多不知情，因為他們只是插入USB隨身碟存取資料。防毒軟體更新後，順利的偵測出病毒，一切又恢復正常。可惜好景不常，病毒作者一直改寫新的病毒，演化出破壞力更強大的病毒。加上它變種的速度比病毒碼更新的速度更快。當你更新完防毒軟體，可以偵測到病毒時，又有新的變種出現。
我們整理一下，當電腦遭受USB病毒感染後，可能會出現以下症狀：
網路裝置元件故障：導致無法上網及更新病毒特徵碼
破壞作業系統：導致程式執行發生錯誤、系統當機（BSOD）、系統日期錯誤
破壞防毒軟體：導致防毒軟體無法運作，或部份元件無法執行
解毒後可能無法直接開啟磁碟機，系統會詢問要以何種應用程式來開啟。或是出現程式執行錯誤的提示訊息。
如果發現電腦有上述症狀，建議立即中斷網路連線（拔除網路線），在確認安全之前，絕對不要使用此電腦登入帳號及密碼，以免被竊取。並且在解毒之後，立即變更密碼。
預設下，當電腦偵測到USB裝置時，Windows系統會自動尋找並執行autorun.inf，進而執行其他應用程式。而病毒也就是利用這個特性來感染。從2006年開始，USB病毒的原型就已經現身，它使用的技術簡單、破壞力也不大，並沒有引起太大的討論。
二年時間過去，它已經不再只是使用單一技術與手法，而是混合多種技術來保護自己不被發現和清除，例如看門狗、自動隱藏、自動更新、社交工程…等。而感染管道也不僅只是USB裝置，它可以透過多種管道來危害你得電腦安全，例如網路磁碟、電子郵件附件檔或檔案。
為了讓使用者更了解USB病毒的感染和擴散方式，以下是我們針對USB病毒（Trojan-GameThief.Win32.OnLineGames.saro、Trojan-GameThief.Win32.Magania.ypk、Trojan-GameThief.Win32.OnLineGames.arvf）進行的分析：
第1階段：木馬程式開始執行
1.在tmep資料夾產生DLL格式的木馬程式。
2.替換系統驅動程式檔案vga.sys，造成防毒軟體元件損毀，無法進入安全模式。
3.產生隱藏屬性的檔案，例如：
windir\system32\kxvo.exe
windir\system32\kxvoX.dll（X為累加數）
4.kxvoX.dll插入explorer.exe執行程序，並持續惡意行為。
第2階段：IExplorer.exe自動下載惡意軟體
1.IExplorer.exe自動下載木馬程式ff.exe至 temp 下，此惡意軟體經常變種，名稱為Trojan-GameThief.Win32.OnLineGames.xxxx。
2.IExplorer.exe會持續在 temp 路徑刪除與建立ff.exe。
第3階段：ff.exe自動執行
1.ff.exe執行後會破壞防毒軟體，或造成某些元件無法運作。
2.替換系統驅動程式檔案tdi.sys。遭替換的tdi.sys檔案會造成網路裝置無法使用，在撥接上網時出現錯誤代碼769。
3.產生隱藏屬性的檔案，例如：
windir\system32\j3ewro.exe（Trojan.Win32.Vaklik.xxx）
windir\system32\jwedsfdo0.dll（Trojan-GameThief.win32.OnLineGames.xxxx）
4.新增登錄檔，以便在登入系統後自動執行惡意軟體。
5.當jwedsfdo0.dll插入explorer.exe執行程序後，由jwedsfdo0.dll持續惡意行為，ff.exe即停止運作。
第4階段：IExplorer.exe自動下載惡意軟體
1.IExplorer.exe自動下載木馬程式cc.exe至 temp 路徑，此惡意軟體經常變種，名稱為Trojan-GameThief.Win32.OnLineGames.xxxx。
2. IExplorer.exe會持續在 temp 路徑刪除與建立cc.exe。
第5階段：惡意軟體藉由explorer.exe執行程序進行惡意攻擊
1.刪除temp路徑下ff.exe惡意軟體。
2.持續修改登錄檔，藉以隱藏惡意檔案。
3.新增登錄檔：當使用者透過「我的電腦」開啟任何磁碟區（包含隨身儲存裝置）時，就會觸發惡意軟體執行。
4.持續在磁碟根目錄刪除與建立autorun.inf及39ysi89.com。
第6階段：cc.exe自動執行
1.如同ff.exe，cc.exe會下載tdi.sys並置換。
2. 產生隱藏屬性的檔案，例如： windir\system32\kxvo.exe （Trojan-GameThief.win32.Magania.xxx）
windir\system32\kxvoX.dll （Trojan-GameThief.win32.Magania.xxx）
3.新增登錄檔，以便在登入系統後自動執行惡意軟體。
4.當kxvoX.dll插入explorer.exe執行程序後，由kxvoX.dll持續惡意行為，cc.exe即停止運作。
第7階段：惡意軟體會在開機時自動啟動及更新
由於病毒持續的變種（透過網路下載新的變種病毒），防毒軟體需要持續更新資料庫，才能偵測出最新的病毒。但是在樣本回報和病毒碼釋出前的空窗期，防毒軟體並無法偵測新的變種。加上它能中斷網路（無法更新）和破壞防毒軟體（無法掃毒），所以坊間出現不少專殺工具和「民俗療法」。
如果正常的醫療管道沒有效果，中國人習慣採用民俗療法。對抗USB病毒的狀況也很類似。新變種、看法狗、停用防毒…等病毒手法，讓使用者不堪其擾，我們收集了網路上流傳的各種治療偏方，請參考下表：
網路偏方 效果說明
建立Autorun.inf資料夾
停用Autorun功能 部份有效 可以暫緩病毒發作。新的變種病毒會先刪除舊有的Autorun.inf資料夾或檔案，或是自行啟動Autorun功能。
建議移除該資料夾安全性頁籤中的所有使用者及群組，才能防止被竄改。
按住 Shift 鍵開啟隨身碟 無效 只能關閉Autoplay，無法關閉Autorun。
在隨身碟上按右鍵開啟檔案總管 部份有效 透過「我的電腦」去點選，仍會遭感染。若正確地透過「檔案總管」來開啟，則不會感染。
啟用隨身碟的唯讀功能 無效 若是隨身碟已感染病毒，只要能執行，就可以感染作業系統。
軟體限制原則 部份有效 能阻止病毒從USB裝置擴散，但無法防範從網路磁碟或郵件附件檔執行。
禁用USB裝置 部份有效 能阻止病毒從USB裝置擴散，但無法防範從網路磁碟或郵件附件檔執行。
USB病毒專殺工具 短期有效 若未定期更新，只能清除舊病毒。而且工具來源不一定安全。
正規療法 效果說明
一般防毒軟體 部份有效 只能偵測已知病毒。
啟發式分析 部份有效 能偵測部份未知病毒，需持續更新規則才能偵測新變種。
HIPS防護軟體 部份有效 需設定正確的規則，才能夠防止病毒執行，設定上較複雜。
KIS 2009有效 具備防毒、啟發式分析及HIPS功能，可有效防護USB病毒。
從上表來看，一些網路偏方根本沒有效果，另一些則只能治標無法治本，即使「禁用USB裝置」，仍然會感染病毒。USB病毒專殺工具的優點是能夠很快速解毒，但效用並不長，大概只有2週的生命周期，病毒作者就會更改新的檔案名稱，或利用其他手法。
目前比較可行的防禦方式是使用HIPS，在病毒執行時就加以阻擋，但對一般使用者而言，設定上比較繁鎖。而內建HIPS功能的KIS 2009，則是由系統自動將程式分類，建立專屬的存取規則，可以很方便快速的就擋下USB病毒。
你也許會問，為什麼防毒軟體無法提供有效的防護呢？
其實答案很簡單。防毒軟體屬於被動防護，必須要有病毒特徵碼，才能偵測與解毒。當病毒樣本未被分析之前，防毒軟體就無法偵測。加上病毒都是小區域暴發（之前是全球大規則暴發，較易收集樣本），根據卡巴斯基實驗室的統計，與台灣相比，中國就較少出現這類型的病毒。
防毒軟體能否解毒的關鍵因素為，是否已經病毒樣本，並將病毒特徵碼（包含偵測及解毒方式）加入病毒資料庫中。為了有效解決USB病毒（KAVO），並且快速收集未知病毒的樣本，奕瑞科技提供USB病毒的解毒與樣本收集工具－NGS（New GetSample），希望透過社群的力量，一同對抗惡意軟體。
使用者只要點選此工具，即可刪除已知的惡意物件，並將可疑物件壓縮加密，請將桌面上的VirusSample.rar寄回奕瑞科技客服信箱：techsupport@kaspersky.com.tw 。
此專殺工具由奕瑞科技提供於正版使用者，若您有需求可透過e mail，寄至客服信箱：techsupport@kaspersky.com.tw
來信敬請附上您的「使用者名稱」、「序號」；若您是企業用戶，敬請附上「公司名稱」、「統一編號」、「聯絡人以及聯絡方式」
奕瑞科技提供的NGS工具，將會檢查系統狀態，並執行下列動作：
步驟1、檢查系統開機模式，並提示進入安全模式
在安全模式下，只會載入必要的程式和服務，可避開「看門狗」，並能直接刪除檔案。建議在安全模式下進行解毒工作。
步驟2、清除電腦中IFEO資料
HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Image File Execution Options
步驟3、清除惡意物件
依照清單的內容，清除已知的惡意物件。在清除物件前需停止某些程序：
1. 停止電腦中的處理程序[StopProcess]
2. 停止並刪除系統服務[DelService]
3. 停止並刪除系統驅動[DelDrivers]
4. 刪除特定登錄檔[DelRegValue]
5. 收集特定檔案並且刪除之[DelSpecFiles]
步驟4、檢查磁碟機根目錄是否有Autorun.inf，及附屬其中的執行檔
若偵測到Autorun.inf及其附屬的執行檔，均會加以刪除。
步驟5、修正顯示隱藏檔的登錄檔
HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\
Explorer\Advanced\Folder\Hidden\SHOWALL
"CheckedValue"=dword:00000001
步驟6、重設hosts檔案為預設值
127.0.0.1localhost
步驟7、呼叫卡巴斯基防毒軟體掃描啟動物件
步驟8、確認是否重新啟動電腦
NGS的處理過程會記錄在使用者桌面的gvslog.txt檔案中，可疑樣本會壓縮加密為VirusSample.rar，而卡巴斯基防毒軟體的掃瞄記錄即儲存在autoscan.log。
未來，隨著雲端運算的發展，樣本的收集和分析速度將會越來越多。透過Kaspersky Security Network服務，卡巴斯基的產品將能更快速的識別新威脅，並減少針對新安全風險所花費的時間。該服務收集選定的安全和應用程式資料，將它們上傳到卡巴斯基實驗室進行分析，以便確定新的威脅和它們的來源，並協助提高使用者的安全性和產品功能。
預防感冒的最佳方法是均衡飲食、時常運動、注意衛生；預防中毒的最佳方式，則有以下幾點：
不要因為一時的好奇心，而任意開啟或執行來路不明的檔案。
在開啟檔案之前，建議先以防毒軟體進行掃瞄。
定期更新防毒軟體、並執行完整掃瞄。
選擇具備主機型入侵防禦系統（HIPS）的安全防護軟體。
USB病毒讓許多使用者和MIS頭痛不已，因為它防不勝防，殺了又中、中了再殺，無止盡的變種病毒更讓防毒軟體防不勝防。 許多人認為抓不到病毒是防毒軟體的原罪，於是尋求其他的解決方案。但在之下，這些方法真的有效嗎？本文將帶你深入了解USB病毒的危害、手法及防禦之道。
去年，USB病毒的主要目的是竊取線上遊戲的帳號和密碼，針對其目的而言，如果使用者本身沒有玩線上遊戲，這些病毒並不會帶來多大的損失，頂多只是看不到系統的隱藏檔，系統效能被拖慢一些。但在病毒持續變種之下，除了竊取帳號密碼，還會破壞網路裝置（網路中斷）、無法進入安全模式、停用防毒軟體、無法執行某些程式…。當到這個階段，使用者才會感到麻煩大了。
在病毒感染的初期，使用者大多不知情，因為他們只是插入USB隨身碟存取資料。防毒軟體更新後，順利的偵測出病毒，一切又恢復正常。可惜好景不常，病毒作者一直改寫新的病毒，演化出破壞力更強大的病毒。加上它變種的速度比病毒碼更新的速度更快。當你更新完防毒軟體，可以偵測到病毒時，又有新的變種出現。
我們整理一下，當電腦遭受USB病毒感染後，可能會出現以下症狀：
網路裝置元件故障：導致無法上網及更新病毒特徵碼
破壞作業系統：導致程式執行發生錯誤、系統當機（BSOD）、系統日期錯誤
破壞防毒軟體：導致防毒軟體無法運作，或部份元件無法執行
解毒後可能無法直接開啟磁碟機，系統會詢問要以何種應用程式來開啟。或是出現程式執行錯誤的提示訊息。
如果發現電腦有上述症狀，建議立即中斷網路連線（拔除網路線），在確認安全之前，絕對不要使用此電腦登入帳號及密碼，以免被竊取。並且在解毒之後，立即變更密碼。
預設下，當電腦偵測到USB裝置時，Windows系統會自動尋找並執行autorun.inf，進而執行其他應用程式。而病毒也就是利用這個特性來感染。從2006年開始，USB病毒的原型就已經現身，它使用的技術簡單、破壞力也不大，並沒有引起太大的討論。
二年時間過去，它已經不再只是使用單一技術與手法，而是混合多種技術來保護自己不被發現和清除，例如看門狗、自動隱藏、自動更新、社交工程…等。而感染管道也不僅只是USB裝置，它可以透過多種管道來危害你得電腦安全，例如網路磁碟、電子郵件附件檔或檔案。
為了讓使用者更了解USB病毒的感染和擴散方式，以下是我們針對USB病毒（Trojan-GameThief.Win32.OnLineGames.saro、Trojan-GameThief.Win32.Magania.ypk、Trojan-GameThief.Win32.OnLineGames.arvf）進行的分析：
第1階段：木馬程式開始執行
1.在tmep資料夾產生DLL格式的木馬程式。
2.替換系統驅動程式檔案vga.sys，造成防毒軟體元件損毀，無法進入安全模式。
3.產生隱藏屬性的檔案，例如：
windir\system32\kxvo.exe
windir\system32\kxvoX.dll（X為累加數）
4.kxvoX.dll插入explorer.exe執行程序，並持續惡意行為。
第2階段：IExplorer.exe自動下載惡意軟體
1.IExplorer.exe自動下載木馬程式ff.exe至 temp 下，此惡意軟體經常變種，名稱為Trojan-GameThief.Win32.OnLineGames.xxxx。
2.IExplorer.exe會持續在 temp 路徑刪除與建立ff.exe。
第3階段：ff.exe自動執行
1.ff.exe執行後會破壞防毒軟體，或造成某些元件無法運作。
2.替換系統驅動程式檔案tdi.sys。遭替換的tdi.sys檔案會造成網路裝置無法使用，在撥接上網時出現錯誤代碼769。
3.產生隱藏屬性的檔案，例如：
windir\system32\j3ewro.exe（Trojan.Win32.Vaklik.xxx）
windir\system32\jwedsfdo0.dll（Trojan-GameThief.win32.OnLineGames.xxxx）
4.新增登錄檔，以便在登入系統後自動執行惡意軟體。
5.當jwedsfdo0.dll插入explorer.exe執行程序後，由jwedsfdo0.dll持續惡意行為，ff.exe即停止運作。
第4階段：IExplorer.exe自動下載惡意軟體
1.IExplorer.exe自動下載木馬程式cc.exe至 temp 路徑，此惡意軟體經常變種，名稱為Trojan-GameThief.Win32.OnLineGames.xxxx。
2. IExplorer.exe會持續在 temp 路徑刪除與建立cc.exe。
第5階段：惡意軟體藉由explorer.exe執行程序進行惡意攻擊
1.刪除temp路徑下ff.exe惡意軟體。
2.持續修改登錄檔，藉以隱藏惡意檔案。
3.新增登錄檔：當使用者透過「我的電腦」開啟任何磁碟區（包含隨身儲存裝置）時，就會觸發惡意軟體執行。
4.持續在磁碟根目錄刪除與建立autorun.inf及39ysi89.com。
第6階段：cc.exe自動執行
1.如同ff.exe，cc.exe會下載tdi.sys並置換。
2. 產生隱藏屬性的檔案，例如： windir\system32\kxvo.exe （Trojan-GameThief.win32.Magania.xxx）
windir\system32\kxvoX.dll （Trojan-GameThief.win32.Magania.xxx）
3.新增登錄檔，以便在登入系統後自動執行惡意軟體。
4.當kxvoX.dll插入explorer.exe執行程序後，由kxvoX.dll持續惡意行為，cc.exe即停止運作。
第7階段：惡意軟體會在開機時自動啟動及更新
由於病毒持續的變種（透過網路下載新的變種病毒），防毒軟體需要持續更新資料庫，才能偵測出最新的病毒。但是在樣本回報和病毒碼釋出前的空窗期，防毒軟體並無法偵測新的變種。加上它能中斷網路（無法更新）和破壞防毒軟體（無法掃毒），所以坊間出現不少專殺工具和「民俗療法」。
如果正常的醫療管道沒有效果，中國人習慣採用民俗療法。對抗USB病毒的狀況也很類似。新變種、看法狗、停用防毒…等病毒手法，讓使用者不堪其擾，我們收集了網路上流傳的各種治療偏方，請參考下表：
網路偏方 效果說明
建立Autorun.inf資料夾
停用Autorun功能 部份有效 可以暫緩病毒發作。新的變種病毒會先刪除舊有的Autorun.inf資料夾或檔案，或是自行啟動Autorun功能。
建議移除該資料夾安全性頁籤中的所有使用者及群組，才能防止被竄改。
按住 Shift 鍵開啟隨身碟 無效 只能關閉Autoplay，無法關閉Autorun。
在隨身碟上按右鍵開啟檔案總管 部份有效 透過「我的電腦」去點選，仍會遭感染。若正確地透過「檔案總管」來開啟，則不會感染。
啟用隨身碟的唯讀功能 無效 若是隨身碟已感染病毒，只要能執行，就可以感染作業系統。
軟體限制原則 部份有效 能阻止病毒從USB裝置擴散，但無法防範從網路磁碟或郵件附件檔執行。
禁用USB裝置 部份有效 能阻止病毒從USB裝置擴散，但無法防範從網路磁碟或郵件附件檔執行。
USB病毒專殺工具 短期有效 若未定期更新，只能清除舊病毒。而且工具來源不一定安全。
正規療法 效果說明
一般防毒軟體 部份有效 只能偵測已知病毒。
啟發式分析 部份有效 能偵測部份未知病毒，需持續更新規則才能偵測新變種。
HIPS防護軟體 部份有效 需設定正確的規則，才能夠防止病毒執行，設定上較複雜。
KIS 2009有效 具備防毒、啟發式分析及HIPS功能，可有效防護USB病毒。
從上表來看，一些網路偏方根本沒有效果，另一些則只能治標無法治本，即使「禁用USB裝置」，仍然會感染病毒。USB病毒專殺工具的優點是能夠很快速解毒，但效用並不長，大概只有2週的生命周期，病毒作者就會更改新的檔案名稱，或利用其他手法。
目前比較可行的防禦方式是使用HIPS，在病毒執行時就加以阻擋，但對一般使用者而言，設定上比較繁鎖。而內建HIPS功能的KIS 2009，則是由系統自動將程式分類，建立專屬的存取規則，可以很方便快速的就擋下USB病毒。
你也許會問，為什麼防毒軟體無法提供有效的防護呢？
其實答案很簡單。防毒軟體屬於被動防護，必須要有病毒特徵碼，才能偵測與解毒。當病毒樣本未被分析之前，防毒軟體就無法偵測。加上病毒都是小區域暴發（之前是全球大規則暴發，較易收集樣本），根據卡巴斯基實驗室的統計，與台灣相比，中國就較少出現這類型的病毒。
防毒軟體能否解毒的關鍵因素為，是否已經病毒樣本，並將病毒特徵碼（包含偵測及解毒方式）加入病毒資料庫中。為了有效解決USB病毒（KAVO），並且快速收集未知病毒的樣本，奕瑞科技提供USB病毒的解毒與樣本收集工具－NGS（New GetSample），希望透過社群的力量，一同對抗惡意軟體。
使用者只要點選此工具，即可刪除已知的惡意物件，並將可疑物件壓縮加密，請將桌面上的VirusSample.rar寄回奕瑞科技客服信箱：techsupport@kaspersky.com.tw 。
此專殺工具由奕瑞科技提供於正版使用者，若您有需求可透過e mail，寄至客服信箱：techsupport@kaspersky.com.tw
來信敬請附上您的「使用者名稱」、「序號」；若您是企業用戶，敬請附上「公司名稱」、「統一編號」、「聯絡人以及聯絡方式」
奕瑞科技提供的NGS工具，將會檢查系統狀態，並執行下列動作：
步驟1、檢查系統開機模式，並提示進入安全模式
在安全模式下，只會載入必要的程式和服務，可避開「看門狗」，並能直接刪除檔案。建議在安全模式下進行解毒工作。
步驟2、清除電腦中IFEO資料
HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Image File Execution Options
步驟3、清除惡意物件
依照清單的內容，清除已知的惡意物件。在清除物件前需停止某些程序：
1. 停止電腦中的處理程序[StopProcess]
2. 停止並刪除系統服務[DelService]
3. 停止並刪除系統驅動[DelDrivers]
4. 刪除特定登錄檔[DelRegValue]
5. 收集特定檔案並且刪除之[DelSpecFiles]
步驟4、檢查磁碟機根目錄是否有Autorun.inf，及附屬其中的執行檔
若偵測到Autorun.inf及其附屬的執行檔，均會加以刪除。
步驟5、修正顯示隱藏檔的登錄檔
HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\
Explorer\Advanced\Folder\Hidden\SHOWALL
"CheckedValue"=dword:00000001
步驟6、重設hosts檔案為預設值
127.0.0.1localhost
步驟7、呼叫卡巴斯基防毒軟體掃描啟動物件
步驟8、確認是否重新啟動電腦
NGS的處理過程會記錄在使用者桌面的gvslog.txt檔案中，可疑樣本會壓縮加密為VirusSample.rar，而卡巴斯基防毒軟體的掃瞄記錄即儲存在autoscan.log。
未來，隨著雲端運算的發展，樣本的收集和分析速度將會越來越多。透過Kaspersky Security Network服務，卡巴斯基的產品將能更快速的識別新威脅，並減少針對新安全風險所花費的時間。該服務收集選定的安全和應用程式資料，將它們上傳到卡巴斯基實驗室進行分析，以便確定新的威脅和它們的來源，並協助提高使用者的安全性和產品功能。
預防感冒的最佳方法是均衡飲食、時常運動、注意衛生；預防中毒的最佳方式，則有以下幾點：
不要因為一時的好奇心，而任意開啟或執行來路不明的檔案。
在開啟檔案之前，建議先以防毒軟體進行掃瞄。
定期更新防毒軟體、並執行完整掃瞄。
選擇具備主機型入侵防禦系統（HIPS）的安全防護軟體。
web 3D game
http://www.instantaction.com/?utm_source=BETA&utm_medium=EMAIL&utm_campaign=Invite_0402081530
國外的網頁3D遊戲，很厲害，網頁遊戲能作成這樣
國外的網頁3D遊戲，很厲害，網頁遊戲能作成這樣
vb.net 序列化與反序列化
序列化
Public Shared Function SpecificationDataTableSerialize(ByVal dt As dsSpecifications.SpecificationDataTable) As String
Dim ser As New System.Xml.Serialization.XmlSerializer(dt.[GetType]())
Dim sb As New StringBuilder()
Dim writer As New System.IO.StringWriter(sb)
ser.Serialize(writer, dt)
Return sb.ToString()
End Function
反序列化
Public Shared Function SpecificationDataTableDeserialize(ByVal s As String) As dsSpecifications.SpecificationDataTable
Dim dt As New dsSpecifications.SpecificationDataTable()
' 如果傳入的 s 字串不是有效的 XML 格式的話，會發生 Exception，記得要做好 Error Handling
Dim xdoc As New System.Xml.XmlDocument()
xdoc.LoadXml(s)
Dim reader As New System.Xml.XmlNodeReader(xdoc.DocumentElement)
Dim ser As New System.Xml.Serialization.XmlSerializer(dt.[GetType]())
Dim obj As Object = ser.Deserialize(reader)
Return TryCast(obj, dsSpecifications.SpecificationDataTable)
End Function
Public Shared Function SpecificationDataTableSerialize(ByVal dt As dsSpecifications.SpecificationDataTable) As String
Dim ser As New System.Xml.Serialization.XmlSerializer(dt.[GetType]())
Dim sb As New StringBuilder()
Dim writer As New System.IO.StringWriter(sb)
ser.Serialize(writer, dt)
Return sb.ToString()
End Function
反序列化
Public Shared Function SpecificationDataTableDeserialize(ByVal s As String) As dsSpecifications.SpecificationDataTable
Dim dt As New dsSpecifications.SpecificationDataTable()
' 如果傳入的 s 字串不是有效的 XML 格式的話，會發生 Exception，記得要做好 Error Handling
Dim xdoc As New System.Xml.XmlDocument()
xdoc.LoadXml(s)
Dim reader As New System.Xml.XmlNodeReader(xdoc.DocumentElement)
Dim ser As New System.Xml.Serialization.XmlSerializer(dt.[GetType]())
Dim obj As Object = ser.Deserialize(reader)
Return TryCast(obj, dsSpecifications.SpecificationDataTable)
End Function
2008年9月19日 星期五
vb.net 用程式寄信(藉由Google mail)
Imports System.Text
Imports System.Net
Imports System.Net.Mail
Imports System.ComponentModel
public sub Send_mail()
' Mail Message Setting
Dim fromEmail As String = "xxxxx@gmail.com"
Dim fromName As String = "name"
Dim from As New MailAddress(fromEmail, fromName, Encoding.UTF8)
Dim toEmail As String = "xxxxx@hotmail.com"
Dim mail As New MailMessage(from, New MailAddress(toEmail))
Dim subject As String = "Test Subject"
mail.Subject = subject
mail.SubjectEncoding = Encoding.UTF8
Dim body As String = "Test Body"
mail.Body = body
mail.BodyEncoding = Encoding.UTF8
mail.IsBodyHtml = False
mail.Priority = MailPriority.High
mail.Attachments.Add(New Mail.Attachment("c:\temp.jpg"))
' SMTP Setting
Dim client As New SmtpClient()
client.Host = "smtp.gmail.com"
client.Port = 587
client.Credentials = New NetworkCredential("xxxxxx@gmail.com", "*******")
client.EnableSsl = True
' Send Mail
client.SendAsync(mail, mail)
AddHandler client.SendCompleted, AddressOf client_SendCompleted
' Sent Compeleted Eevet
end sub
Private Sub client_SendCompleted(ByVal sender As Object, ByVal e As AsyncCompletedEventArgs)
If e.[Error] IsNot Nothing Then
MessageBox.Show(e.[Error].ToString())
Else
MessageBox.Show("Message sent.")
End If
End Sub
Imports System.Net
Imports System.Net.Mail
Imports System.ComponentModel
public sub Send_mail()
' Mail Message Setting
Dim fromEmail As String = "xxxxx@gmail.com"
Dim fromName As String = "name"
Dim from As New MailAddress(fromEmail, fromName, Encoding.UTF8)
Dim toEmail As String = "xxxxx@hotmail.com"
Dim mail As New MailMessage(from, New MailAddress(toEmail))
Dim subject As String = "Test Subject"
mail.Subject = subject
mail.SubjectEncoding = Encoding.UTF8
Dim body As String = "Test Body"
mail.Body = body
mail.BodyEncoding = Encoding.UTF8
mail.IsBodyHtml = False
mail.Priority = MailPriority.High
mail.Attachments.Add(New Mail.Attachment("c:\temp.jpg"))
' SMTP Setting
Dim client As New SmtpClient()
client.Host = "smtp.gmail.com"
client.Port = 587
client.Credentials = New NetworkCredential("xxxxxx@gmail.com", "*******")
client.EnableSsl = True
' Send Mail
client.SendAsync(mail, mail)
AddHandler client.SendCompleted, AddressOf client_SendCompleted
' Sent Compeleted Eevet
end sub
Private Sub client_SendCompleted(ByVal sender As Object, ByVal e As AsyncCompletedEventArgs)
If e.[Error] IsNot Nothing Then
MessageBox.Show(e.[Error].ToString())
Else
MessageBox.Show("Message sent.")
End If
End Sub
2008年9月18日 星期四
report service
論壇
http://www.blueshop.com.tw/board/show.asp?subcde=BRD200807082129121BM&fumcde=fum20041006161839lrj
Microsoft SQL Server Reporting Services
http://www.microsoft.com/downloads/Browse.aspx?displaylang=zh-tw&productID=124E96F3-B848-4441-91D4-8ADDEE3DD833
Microsoft® SQL Server® 2008 Express with Advanced Services
http://www.microsoft.com/downloads/details.aspx?FamilyID=b5d1b8c3-fda5-4508-b0d0-1311d670e336&DisplayLang=zh-tw
sql server2008
http://www.microsoft.com/taiwan/sql2008/download/trial-software.aspx
序號
http://www.dycar.net/blog/article.asp?id=245
http://www.blueshop.com.tw/board/show.asp?subcde=BRD200807082129121BM&fumcde=fum20041006161839lrj
Microsoft SQL Server Reporting Services
http://www.microsoft.com/downloads/Browse.aspx?displaylang=zh-tw&productID=124E96F3-B848-4441-91D4-8ADDEE3DD833
Microsoft® SQL Server® 2008 Express with Advanced Services
http://www.microsoft.com/downloads/details.aspx?FamilyID=b5d1b8c3-fda5-4508-b0d0-1311d670e336&DisplayLang=zh-tw
sql server2008
http://www.microsoft.com/taiwan/sql2008/download/trial-software.aspx
序號
http://www.dycar.net/blog/article.asp?id=245
vb.net 讀取標準設定檔
'方法1
strDSN = Configuration.ConfigurationSettings.AppSettings("strDSN")
'方法2
'加入參考 System.Configuration
strDSN = ConfigurationManager.AppSettings("strDSN")
strDSN = Configuration.ConfigurationSettings.AppSettings("strDSN")
'方法2
'加入參考 System.Configuration
strDSN = ConfigurationManager.AppSettings("strDSN")
2008年9月17日 星期三
vb.net 自動組合SQL語法
dim V_column_name() As String '先把欄位名稱用陣列裝起來
strSQL = "SELECT * FROM " & 欄位名稱 & ""
DS = Query(strSQL)
DGV.DataSource = DS.Tables(0)
ReDim V_column_name(DGV.Columns.Count - 1) '
For kk = 0 To DGV.Columns.Count - 1
V_column_name(kk) = DGV.Columns(kk).HeaderText
Next
For kk = 0 To DGV.Rows.Count - 2
strSQL = "INSERT INTO " & 欄位名稱 & " ("
For II = 0 To V_column_name.Length - 1
If II = V_column_name.Length - 1 Then
strSQL = strSQL & "" & V_column_name(II) & "" & ")"
Else
strSQL = strSQL & "" & V_column_name(II) & "" & " , "
End If
Next
strSQL = strSQL & " VALUES ("
For Jj = 0 To DGV.Columns.Count - 1
If Jj = DGV.Columns.Count - 1 Then
strSQL = strSQL & "'" & DGV.Rows(kk).Cells(Jj).Value & "'" & ")"
Else
strSQL = strSQL & "'" & DGV.Rows(kk).Cells(Jj).Value & "'" & ","
End If
Next
'以上insert會因為資料表的欄位內容、資訊等等，把insert語法自動組合出來
strSQL = "SELECT * FROM " & 欄位名稱 & ""
DS = Query(strSQL)
DGV.DataSource = DS.Tables(0)
ReDim V_column_name(DGV.Columns.Count - 1) '
For kk = 0 To DGV.Columns.Count - 1
V_column_name(kk) = DGV.Columns(kk).HeaderText
Next
For kk = 0 To DGV.Rows.Count - 2
strSQL = "INSERT INTO " & 欄位名稱 & " ("
For II = 0 To V_column_name.Length - 1
If II = V_column_name.Length - 1 Then
strSQL = strSQL & "" & V_column_name(II) & "" & ")"
Else
strSQL = strSQL & "" & V_column_name(II) & "" & " , "
End If
Next
strSQL = strSQL & " VALUES ("
For Jj = 0 To DGV.Columns.Count - 1
If Jj = DGV.Columns.Count - 1 Then
strSQL = strSQL & "'" & DGV.Rows(kk).Cells(Jj).Value & "'" & ")"
Else
strSQL = strSQL & "'" & DGV.Rows(kk).Cells(Jj).Value & "'" & ","
End If
Next
'以上insert會因為資料表的欄位內容、資訊等等，把insert語法自動組合出來
2008年9月14日 星期日
動態使用DLL
'-原始DLL內容
Public Class Class1
Public Sub MSG()
MsgBox("今天是" & Date.Now.Date.ToString("yyyy/MM/dd"))
End Sub
End Class
'-呼叫方法
Imports System
Imports System.Reflection
Imports System.Security.Permissions
Public Class Form1
Dim TAA As System.Reflection.Assembly
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
TAA = System.Reflection.Assembly.LoadFile(System.Windows.Forms.Application.StartupPath & "\1234.dll")
Dim t As Type = TAA.GetType("_1234.Class1") '注意，前面有『_』喔，這是vb.net 2005預先幫你加上去的
Dim obj As Object = t.InvokeMember(Nothing, BindingFlags.DeclaredOnly Or _
BindingFlags.Public Or BindingFlags.NonPublic Or BindingFlags.Instance Or _
BindingFlags.CreateInstance, Nothing, Nothing, Nothing)
obj.msg()
End Sub
End Class
Public Class Class1
Public Sub MSG()
MsgBox("今天是" & Date.Now.Date.ToString("yyyy/MM/dd"))
End Sub
End Class
'-呼叫方法
Imports System
Imports System.Reflection
Imports System.Security.Permissions
Public Class Form1
Dim TAA As System.Reflection.Assembly
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
TAA = System.Reflection.Assembly.LoadFile(System.Windows.Forms.Application.StartupPath & "\1234.dll")
Dim t As Type = TAA.GetType("_1234.Class1") '注意，前面有『_』喔，這是vb.net 2005預先幫你加上去的
Dim obj As Object = t.InvokeMember(Nothing, BindingFlags.DeclaredOnly Or _
BindingFlags.Public Or BindingFlags.NonPublic Or BindingFlags.Instance Or _
BindingFlags.CreateInstance, Nothing, Nothing, Nothing)
obj.msg()
End Sub
End Class
2008年9月12日 星期五
vb.net 自動登入網頁
' 宣告並建立IE 執行個體物件
Dim ie As Object = CreateObject("InternetExplorer.Application")
' Yahoo!奇摩會員登入網址
Dim strURL As String = "http://tw.login.yahoo.com/cgi-bin/login.cgi?srv=www&from=http://tw.yahoo.com"
With ie
.Visible = True ' 顯示IE
.Navigate(strURL) ' 瀏覽網址
' 等待網頁載入完成
Do While .Busy
Application.DoEvents()
Loop
.Document.All("login").Value = "這裡打帳號" ' 帳號
.Document.All("passwd").Value = "這裡打密碼" ' 密碼
.Document.All("submit").Click() ' 登入
End With
ie = Nothing ' 釋放IE 物件
'-------
'千萬不要拿去作壞事呀
Dim ie As Object = CreateObject("InternetExplorer.Application")
' Yahoo!奇摩會員登入網址
Dim strURL As String = "http://tw.login.yahoo.com/cgi-bin/login.cgi?srv=www&from=http://tw.yahoo.com"
With ie
.Visible = True ' 顯示IE
.Navigate(strURL) ' 瀏覽網址
' 等待網頁載入完成
Do While .Busy
Application.DoEvents()
Loop
.Document.All("login").Value = "這裡打帳號" ' 帳號
.Document.All("passwd").Value = "這裡打密碼" ' 密碼
.Document.All("submit").Click() ' 登入
End With
ie = Nothing ' 釋放IE 物件
'-------
'千萬不要拿去作壞事呀
vb.net 連接至paradox
strCN = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & V_file_path & ";Extended Properties=Paradox 5.x;" & _
" "
strSQL = "SELECT * FROM " & V_file_name & ""
" "
strSQL = "SELECT * FROM " & V_file_name & ""
2008年9月10日 星期三
vb.net 模擬滑鼠點下
Option Explicit On
Module MManip
'API 定義
Public Declare Sub Mouse_Event Lib "user32" _
(ByVal dwFlags As int32, ByVal dx As int32, ByVal dy As int32, _
ByVal cButtons As int32, ByVal dwExtraInfo As int32)
Public Declare Function SetCursorPos Lib "user32" _
(ByVal X As int32, ByVal Y As int32) As int32
Public Declare Function GetCursorPos Lib "user32"
(ByRef lpPoint As POINTAPI) As int32
Public Const MOUSEEVENTF_LEFTDOWN = &H2
Public Const MOUSEEVENTF_LEFTUP = &H4
Public Const MOUSEEVENTF_MIDDLEDOWN = &H20
Public Const MOUSEEVENTF_MIDDLEUP = &H40
Public Const MOUSEEVENTF_RIGHTDOWN = &H8
Public Const MOUSEEVENTF_RIGHTUP = &H10
Public Const MOUSEEVENTF_MOVE = &H1
Public Structure POINTAPI
Dim X As Int32
Dim Y As Int32
End Structure
'取得目前滑鼠座標
Public Function GetCurrentPos As POINTAPI
Dim Position As POINTAPI
GetCursorPos(Position)
GetCurrentPos = Position
End Function
'取得目前滑鼠座標 x 值
Public Function GetCurrentX() As int32
Dim Position As POINTAPI
GetCursorPos(Position)
GetCurrentX = Position.X
End Function
'取得目前滑鼠座標 y 值
Public Function GetCurrentY() As int32
Dim Position As POINTAPI
GetCursorPos(Position)
GetCurrentY = Position.Y
End Function
'滑鼠左擊
Public Sub LeftClick()
LeftDown()
LeftUp()
End Sub
'按下滑鼠左鍵
Public Sub LeftDown()
Mouse_Event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0)
End Sub
'放開滑鼠左鍵
Public Sub LeftUp()
Mouse_Event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0)
End Sub
'滑鼠中擊
Public Sub MiddleClick()
MiddleDown()
MiddleUp()
End Sub
'按下滑鼠中鍵
Public Sub MiddleDown()
Mouse_Event(MOUSEEVENTF_MIDDLEDOWN, 0, 0, 0, 0)
End Sub
'放開滑鼠中鍵
Public Sub MiddleUp()
Mouse_Event(MOUSEEVENTF_MIDDLEUP, 0, 0, 0, 0)
End Sub
'移動滑鼠
Public Sub MoveMouse(ByVal xMove As int32, ByVal yMove As int32)
Mouse_Event(MOUSEEVENTF_MOVE, xMove, yMove, 0, 0)
End Sub
'滑鼠右擊
Public Sub RightClick()
RightDown()
RightUp()
End Sub
'按下滑鼠右鍵
Public Sub RightDown()
Mouse_Event(MOUSEEVENTF_RIGHTDOWN, 0, 0, 0, 0)
End Sub
'放開滑鼠右鍵
Public Sub RightUp()
Mouse_Event(MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0)
End Sub
End Module
Module MManip
'API 定義
Public Declare Sub Mouse_Event Lib "user32" _
(ByVal dwFlags As int32, ByVal dx As int32, ByVal dy As int32, _
ByVal cButtons As int32, ByVal dwExtraInfo As int32)
Public Declare Function SetCursorPos Lib "user32" _
(ByVal X As int32, ByVal Y As int32) As int32
Public Declare Function GetCursorPos Lib "user32"
(ByRef lpPoint As POINTAPI) As int32
Public Const MOUSEEVENTF_LEFTDOWN = &H2
Public Const MOUSEEVENTF_LEFTUP = &H4
Public Const MOUSEEVENTF_MIDDLEDOWN = &H20
Public Const MOUSEEVENTF_MIDDLEUP = &H40
Public Const MOUSEEVENTF_RIGHTDOWN = &H8
Public Const MOUSEEVENTF_RIGHTUP = &H10
Public Const MOUSEEVENTF_MOVE = &H1
Public Structure POINTAPI
Dim X As Int32
Dim Y As Int32
End Structure
'取得目前滑鼠座標
Public Function GetCurrentPos As POINTAPI
Dim Position As POINTAPI
GetCursorPos(Position)
GetCurrentPos = Position
End Function
'取得目前滑鼠座標 x 值
Public Function GetCurrentX() As int32
Dim Position As POINTAPI
GetCursorPos(Position)
GetCurrentX = Position.X
End Function
'取得目前滑鼠座標 y 值
Public Function GetCurrentY() As int32
Dim Position As POINTAPI
GetCursorPos(Position)
GetCurrentY = Position.Y
End Function
'滑鼠左擊
Public Sub LeftClick()
LeftDown()
LeftUp()
End Sub
'按下滑鼠左鍵
Public Sub LeftDown()
Mouse_Event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0)
End Sub
'放開滑鼠左鍵
Public Sub LeftUp()
Mouse_Event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0)
End Sub
'滑鼠中擊
Public Sub MiddleClick()
MiddleDown()
MiddleUp()
End Sub
'按下滑鼠中鍵
Public Sub MiddleDown()
Mouse_Event(MOUSEEVENTF_MIDDLEDOWN, 0, 0, 0, 0)
End Sub
'放開滑鼠中鍵
Public Sub MiddleUp()
Mouse_Event(MOUSEEVENTF_MIDDLEUP, 0, 0, 0, 0)
End Sub
'移動滑鼠
Public Sub MoveMouse(ByVal xMove As int32, ByVal yMove As int32)
Mouse_Event(MOUSEEVENTF_MOVE, xMove, yMove, 0, 0)
End Sub
'滑鼠右擊
Public Sub RightClick()
RightDown()
RightUp()
End Sub
'按下滑鼠右鍵
Public Sub RightDown()
Mouse_Event(MOUSEEVENTF_RIGHTDOWN, 0, 0, 0, 0)
End Sub
'放開滑鼠右鍵
Public Sub RightUp()
Mouse_Event(MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0)
End Sub
End Module
2008年9月9日 星期二
建立連動的DGV與ProgressBar
'------滑鼠點下去的瞬間，row會被ProgressBar取代掉，而ProgressBar會隨著DGV 的滾動而上下移動，看起來ProgressBar是『黏在』DGV的ROW上面'----全域變數
Public Class Form1
Dim DS As New DataSet
Dim V_RowIndex As Integer
Dim V_pcb_name As String
'-----表單開始
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Dim sDT, eDT As String
sDT = Date.Now.Date.ToString("yyyy/MM/dd")
eDT = Convert.ToDateTime(sDT).AddDays(1).ToString("yyyy/MM/dd")
Dim Ii, TimeStep, RoomStep As Integer
TimeStep = 1
RoomStep = 5
For Ii = 0 To 24 Step TimeStep
Dim V_col As New DataGridViewTextBoxColumn
DGV.Columns.Add(V_col)
DGV.Columns(Ii).Width = 30
DGV.Columns(Ii).HeaderText = Ii & ":00"
Next
Dim limingTable As DataTable = DS.Tables.Add("rm_sch_d")
'假裝成從資料庫撈資料
' 建立「Rm_no」欄位
limingTable.Columns.Add("Rm_no", System.Type.GetType("System.String"))
' 建立「arr_date」欄位
limingTable.Columns.Add("arr_time", System.Type.GetType("System.String"))
' 建立「dep_date」欄位
limingTable.Columns.Add("dep_time", System.Type.GetType("System.String"))
' 以下我們要將資料列新增至資料集 DS 當中的「rm_sch_d」資料表
Dim newRow As DataRow
newRow = DS.Tables("rm_sch_d").NewRow()
newRow("Rm_no") = "2201"
newRow("arr_time") = "06:30"
newRow("dep_time") = "14:13"
DS.Tables("rm_sch_d").Rows.Add(newRow)
newRow = DS.Tables("rm_sch_d").NewRow()
newRow("Rm_no") = "2202"
newRow("arr_time") = "12:15"
newRow("dep_time") = "16:05"
DS.Tables("rm_sch_d").Rows.Add(newRow)
newRow = DS.Tables("rm_sch_d").NewRow()
newRow("Rm_no") = "2203"
newRow("arr_time") = "09:23"
newRow("dep_time") = "12:00"
DS.Tables("rm_sch_d").Rows.Add(newRow)
newRow = DS.Tables("rm_sch_d").NewRow()
newRow("Rm_no") = "2204"
newRow("arr_time") = "10:13"
newRow("dep_time") = "14:30"
DS.Tables("rm_sch_d").Rows.Add(newRow)
newRow = DS.Tables("rm_sch_d").NewRow()
newRow("Rm_no") = "2205"
newRow("arr_time") = "11:30"
newRow("dep_time") = "20:30"
DS.Tables("rm_sch_d").Rows.Add(newRow)
newRow = DS.Tables("rm_sch_d").NewRow()
newRow("Rm_no") = "2206"
newRow("arr_time") = "12:59"
newRow("dep_time") = "20:30"
DS.Tables("rm_sch_d").Rows.Add(newRow)
newRow = DS.Tables("rm_sch_d").NewRow()
newRow("Rm_no") = "2207"
newRow("arr_time") = "01:11"
newRow("dep_time") = "23:30"
DS.Tables("rm_sch_d").Rows.Add(newRow)
newRow = DS.Tables("rm_sch_d").NewRow()
newRow("Rm_no") = "2208"
newRow("arr_time") = "02:30"
newRow("dep_time") = "20:30"
DS.Tables("rm_sch_d").Rows.Add(newRow)
newRow = DS.Tables("rm_sch_d").NewRow()
newRow("Rm_no") = "2209"
newRow("arr_time") = "07:30"
newRow("dep_time") = "20:30"
DS.Tables("rm_sch_d").Rows.Add(newRow)
newRow = DS.Tables("rm_sch_d").NewRow()
newRow("Rm_no") = "2210"
newRow("arr_time") = "11:30"
newRow("dep_time") = "11:45"
DS.Tables("rm_sch_d").Rows.Add(newRow)
newRow = DS.Tables("rm_sch_d").NewRow()
newRow("Rm_no") = "2211"
newRow("arr_time") = "01:30"
newRow("dep_time") = "23:30"
DS.Tables("rm_sch_d").Rows.Add(newRow)
newRow = DS.Tables("rm_sch_d").NewRow()
newRow("Rm_no") = "2212"
newRow("arr_time") = "11:30"
newRow("dep_time") = "20:30"
DS.Tables("rm_sch_d").Rows.Add(newRow)
newRow = DS.Tables("rm_sch_d").NewRow()
newRow("Rm_no") = "2213"
newRow("arr_time") = "03:30"
newRow("dep_time") = "20:30"
DS.Tables("rm_sch_d").Rows.Add(newRow)
newRow = DS.Tables("rm_sch_d").NewRow()
newRow("Rm_no") = "2214"
newRow("arr_time") = "19:30"
newRow("dep_time") = "20:30"
DS.Tables("rm_sch_d").Rows.Add(newRow)
newRow = DS.Tables("rm_sch_d").NewRow()
newRow("Rm_no") = "2215"
newRow("arr_time") = "05:30"
newRow("dep_time") = "20:30"
DS.Tables("rm_sch_d").Rows.Add(newRow)
newRow = DS.Tables("rm_sch_d").NewRow()
newRow("Rm_no") = "2216"
newRow("arr_time") = "19:30"
newRow("dep_time") = "20:00"
DS.Tables("rm_sch_d").Rows.Add(newRow)
newRow = DS.Tables("rm_sch_d").NewRow()
newRow("Rm_no") = "2217"
newRow("arr_time") = "11:30"
newRow("dep_time") = "12:30"
DS.Tables("rm_sch_d").Rows.Add(newRow)
newRow = DS.Tables("rm_sch_d").NewRow()
newRow("Rm_no") = "2218"
newRow("arr_time") = "01:30"
newRow("dep_time") = "23:30"
DS.Tables("rm_sch_d").Rows.Add(newRow)
newRow = DS.Tables("rm_sch_d").NewRow()
newRow("Rm_no") = "2219"
newRow("arr_time") = "11:30"
newRow("dep_time") = "23:30"
DS.Tables("rm_sch_d").Rows.Add(newRow)
newRow = DS.Tables("rm_sch_d").NewRow()
newRow("Rm_no") = "2220"
newRow("arr_time") = "02:22"
newRow("dep_time") = "04:30"
DS.Tables("rm_sch_d").Rows.Add(newRow) ' 接受所新增的資料列 limingTable.AcceptChanges()
For Ii = 0 To DS.Tables("rm_sch_d").Rows.Count - 1
DGV.Rows.Add()
DGV.Rows(Ii).HeaderCell.Value = DS.Tables("rm_sch_d").Rows(Ii).Item("Rm_no") Next
DGV.RowHeadersWidth = 60
'v_click = False
V_RowIndex = 1000
End Sub
Private Sub DGV_CellClick(ByVal sender As Object, ByVal e As System.Windows.Forms.DataGridViewCellEventArgs) Handles DGV.CellClick
Dim ii As Integer
Dim Gen_PCB As New PCB_bar
For ii = 0 To DGV.Rows.Count - 1
Try
Dim obj As Object = DGV.Controls.Find("PCB" & DGV.Rows(ii).HeaderCell.Value, False) Dim PCB As ProgressBar = CType(obj(0), ProgressBar)
PCB.Dispose()
Catch ex As Exception
End Try
Next
Gen_PCB.Gen_PCB(DGV, e.RowIndex - DGV.Rows.GetFirstRow(DataGridViewElementStates.Displayed), DS.Tables(0).Rows(e.RowIndex).Item("arr_time"), DS.Tables(0).Rows(e.RowIndex).Item("dep_time"), DS.Tables(0).Rows(e.RowIndex).Item("arr_time") & "~" & DS.Tables(0).Rows(e.RowIndex).Item("dep_time"))
V_pcb_name = "PCB" & DGV.Rows(e.RowIndex - DGV.Rows.GetFirstRow(DataGridViewElementStates.Displayed)).HeaderCell.Value
End Sub
Private Sub DGV_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles DGV.Paint
Dim i As Integer
Dim Gen_Box As New Paint_bar
For i = DGV.Rows.GetFirstRow(DataGridViewElementStates.Displayed) To DGV.Rows.GetLastRow(DataGridViewElementStates.Displayed) - 1
If V_RowIndex <> i Then
Gen_Box.Gen_Box(DGV, i - DGV.Rows.GetFirstRow(DataGridViewElementStates.Displayed), DS.Tables(0).Rows(i).Item("Arr_time"), DS.Tables(0).Rows(i).Item("dep_time"), "", Brushes.Aqua, Brushes.Pink)
End If
Next
End Sub
Private Sub DGV_Scroll(ByVal sender As Object, ByVal e As System.Windows.Forms.ScrollEventArgs) Handles DGV.Scroll
'MsgBox(e.NewValue)
'MsgBox(e.OldValue)
Dim ii As Integer
Try
Dim obj As Object = DGV.Controls.Find(V_pcb_name, False)
Dim PCB As ProgressBar = CType(obj(0), ProgressBar)
PCB.Location = New System.Drawing.Point(PCB.Location.X, PCB.Location.Y + (e.OldValue - e.NewValue) * DGV.Rows(0).Height)
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Sub
End Class
'----class
Public Class Paint_bar
Public Sub Gen_Box(ByVal DGV1 As DataGridView, ByVal R_index As Integer, ByVal Stime As DateTime, ByVal Etime As DateTime, ByVal TT_str As String, ByVal V_color As Brush, ByVal V_N_color As Brush)
Dim G As Graphics = DGV1.CreateGraphics
Dim Jj As Integer
Dim kk, Pp As DateTime
Dim Spoint_X, Spoint_y, Epoint_X, Epoint_Y As Integer
kk = Stime.ToString("HH:mm")
Pp = Etime.ToString("HH:mm")
Jj = DateDiff(DateInterval.Minute, kk, Pp)
Spoint_X = DGV1.RowHeadersWidth + DGV1.Columns(R_index).Width * Stime.ToString("HH") + (Stime.ToString("mm") / 60 * DGV1.Columns(R_index).Width)
Spoint_y = DGV1.Rows(R_index).Height * R_index + DGV1.ColumnHeadersHeight + 1 Epoint_X = Jj / 60 * DGV1.Columns(R_index).Width
Epoint_Y = DGV1.Rows(R_index).Height - 1
Dim rect As New Rectangle(Spoint_X, Spoint_y, Epoint_X, Epoint_Y)
G.FillRectangle(V_color, rect)
Dim fontb As New Font("新細明體", 8, FontStyle.Bold)
G.DrawString(Stime.ToString("HH:mm") & " ~ " & Etime.ToString("HH:mm"), fontb, V_N_color, Spoint_X, Spoint_y)
End Sub
End Class
Public Class PCB_bar
Public Sub Gen_PCB(ByVal DGV1 As DataGridView, ByVal R_index As Integer, ByVal Stime As DateTime, ByVal Etime As DateTime, ByVal TT_str As String)
Dim PCB As New ProgressBar
Dim Jj As Integer
Dim kk, Pp As DateTime
Dim tt As New ToolTip
Dim g As Graphics = PCB.CreateGraphics
Dim Spoint_X, Spoint_y, Epoint_X, Epoint_Y As Integer
PCB.Name = "PCB" & DGV1.Rows(R_index).HeaderCell.Value
Spoint_X = DGV1.RowHeadersWidth + DGV1.Columns(R_index).Width * Stime.ToString("HH") + (Stime.ToString("mm") / 60 * DGV1.Columns(R_index).Width)
Spoint_y = DGV1.Rows(R_index).Height * R_index + DGV1.ColumnHeadersHeight PCB.Location = New System.Drawing.Point(Spoint_X, Spoint_y)
kk = Stime.ToString("HH:mm")
Pp = Etime.ToString("HH:mm")
Jj = DateDiff(DateInterval.Minute, kk, Pp)
Epoint_X = Jj / 60 * DGV1.Columns(R_index).Width
Epoint_Y = DGV1.Rows(R_index).Height
PCB.Size = New System.Drawing.Size(Epoint_X, Epoint_Y)
PCB.Value = 100
PCB.Show()
tt.SetToolTip(PCB, TT_str)
DGV1.Controls.Add(PCB)
Dim fontb As New Font("新細明體", 14, FontStyle.Bold)
g.DrawString(TT_str, fontb, Brushes.DarkKhaki, 0, 0)
AddHandler PCB.Click, AddressOf PCB_click
End Sub
Public Sub PCB_click(ByVal sender As System.Object, ByVal e As System.EventArgs) MsgBox(sender.name)
Select Case sender.name
End Select
End Sub
End Class
2008年9月8日 星期一
vb.net圖片進出資料庫
'--------------------把照片擺進資料庫'
Dim dteStart As DateTime = Now
Dim cn As New IfxConnection(strCN)
Dim pic_byte = My.Computer.FileSystem.ReadAllBytes("c:\1.jpg")
Dim connectStringBuilder As New OleDb.OleDbConnectionStringBuilder()
Using con As IfxConnection = New IfxConnection(connectStringBuilder.ConnectionString) ' 新增資料記錄的 INSERT 陳述式
Dim insertStr As String = _
"INSERT INTO test (ser_no , pic ) VALUES (" & _ " '2' , ? )"
' 使用 SqlCommand 類別的第三個建構函式來建立 SqlCommand 物件
' 並將內含參數的 INSERT 陳述式指派給 SqlCommand 物件
Dim insertCMD As New IfxCommand(insertStr, cn)
' 於參數集合中替各個參數加入一個參數物件並設定這些參數的值
' 於參數集合中參數 @ThumbNailPhoto 加入一個參數物件並設定其值
insertCMD.Parameters.Add("?ThumbnailPhotoFileName", SqlDbType.Image, pic_byte.Length).Value = pic_byte
'MsgBox(insertStr)
' 開啟連接
insertCMD.Connection.Open()
' 執行資料命令來新增資料記錄
insertCMD.ExecuteNonQuery()
insertCMD.Connection.Close()
pic_byte = Nothing
Pibox.Image = Nothing
End Using
'Dim TS As TimeSpan = Now.Subtract(dteStart)
'MsgBox("執行時間: " & TS.TotalMilliseconds & " 毫秒")
'-----------------------------把照片讀出來
Dim Cn As New IfxConnection(strCN)
Dim Da As New IfxDataAdapter(strSQL, Cn)
Dim Cmd As New IfxCommand(strSQL, Cn)
Dim DS As New DataSet
strSQL = "SELECT * FROM test WHERE ser_no = 2"
Cmd.CommandText = strSQL
Da.SelectCommand = Cmd
Cmd.Connection.Open()
Da.Fill(DS)
Cmd.Connection.Close()
If Not IsDBNull(DS.Tables(0).Rows(0).Item(1)) Then
Try
Dim tmpImageFile As String = My.Computer.FileSystem.GetTempFileName
My.Computer.FileSystem.WriteAllBytes(tmpImageFile, DS.Tables(0).Rows(0).Item(1), False)
Me.Pibox.Image = Image.FromFile(tmpImageFile) My.Computer.FileSystem.DeleteFile(tmpImageFile)
Catch ex As Exception
End Try
Else
Me.Pibox.Image = Nothing
End If
Dim dteStart As DateTime = Now
Dim cn As New IfxConnection(strCN)
Dim pic_byte = My.Computer.FileSystem.ReadAllBytes("c:\1.jpg")
Dim connectStringBuilder As New OleDb.OleDbConnectionStringBuilder()
Using con As IfxConnection = New IfxConnection(connectStringBuilder.ConnectionString) ' 新增資料記錄的 INSERT 陳述式
Dim insertStr As String = _
"INSERT INTO test (ser_no , pic ) VALUES (" & _ " '2' , ? )"
' 使用 SqlCommand 類別的第三個建構函式來建立 SqlCommand 物件
' 並將內含參數的 INSERT 陳述式指派給 SqlCommand 物件
Dim insertCMD As New IfxCommand(insertStr, cn)
' 於參數集合中替各個參數加入一個參數物件並設定這些參數的值
' 於參數集合中參數 @ThumbNailPhoto 加入一個參數物件並設定其值
insertCMD.Parameters.Add("?ThumbnailPhotoFileName", SqlDbType.Image, pic_byte.Length).Value = pic_byte
'MsgBox(insertStr)
' 開啟連接
insertCMD.Connection.Open()
' 執行資料命令來新增資料記錄
insertCMD.ExecuteNonQuery()
insertCMD.Connection.Close()
pic_byte = Nothing
Pibox.Image = Nothing
End Using
'Dim TS As TimeSpan = Now.Subtract(dteStart)
'MsgBox("執行時間: " & TS.TotalMilliseconds & " 毫秒")
'-----------------------------把照片讀出來
Dim Cn As New IfxConnection(strCN)
Dim Da As New IfxDataAdapter(strSQL, Cn)
Dim Cmd As New IfxCommand(strSQL, Cn)
Dim DS As New DataSet
strSQL = "SELECT * FROM test WHERE ser_no = 2"
Cmd.CommandText = strSQL
Da.SelectCommand = Cmd
Cmd.Connection.Open()
Da.Fill(DS)
Cmd.Connection.Close()
If Not IsDBNull(DS.Tables(0).Rows(0).Item(1)) Then
Try
Dim tmpImageFile As String = My.Computer.FileSystem.GetTempFileName
My.Computer.FileSystem.WriteAllBytes(tmpImageFile, DS.Tables(0).Rows(0).Item(1), False)
Me.Pibox.Image = Image.FromFile(tmpImageFile) My.Computer.FileSystem.DeleteFile(tmpImageFile)
Catch ex As Exception
End Try
Else
Me.Pibox.Image = Nothing
End If
vb.net開機時啟動程式(登錄檔法)
Dim strTmp As String
Dim AddKey As Microsoft.Win32.RegistryKey = My.Computer.Registry.LocalMachine.OpenSubKey("Software\Microsoft\Windows\CurrentVersion\Run", True)
If AddKey.GetValue("HFservice") = "" Then
AddKey.SetValue("HFservice", Application.ExecutablePath, Microsoft.Win32.RegistryValueKind.String)
MsgBox("設定成功")
Else
MsgBox("已設定成開機啟動")
End If
Dim AddKey As Microsoft.Win32.RegistryKey = My.Computer.Registry.LocalMachine.OpenSubKey("Software\Microsoft\Windows\CurrentVersion\Run", True)
If AddKey.GetValue("HFservice") = "" Then
AddKey.SetValue("HFservice", Application.ExecutablePath, Microsoft.Win32.RegistryValueKind.String)
MsgBox("設定成功")
Else
MsgBox("已設定成開機啟動")
End If
vb.net 多執行緒控制物件Label跟button
Dim MainThread As New Threading.Thread(AddressOf MainProcess)'定義新的執行序.......
MainThread.Start()'執行序啟動'跨執行序呼叫元件,label 跟 button'-------------------
Public Sub SetButton(ByVal [text] As String, ByVal BTN As Button)
' InvokeRequired required compares the thread ID of the
' calling thread to the thread ID of the creating thread.
' If these threads are different, it returns true.
If BTN.InvokeRequired Then
Dim d As New SetButtonCallback(AddressOf SetButton)
BTN.Invoke(d, New Object() {Convert.ToString([text]), BTN})
Else
BTN.Text = [text]
End If
End Sub
Delegate Sub SetButtonCallback(ByVal [text] As String, ByVal BTN As Button)'----------------------------------------Label
Public Sub SetText(ByVal [text] As String, ByVal Lab As Label)
' InvokeRequired required compares the thread ID of the
' calling thread to the thread ID of the creating thread.
' If these threads are different, it returns true.
If Lab.InvokeRequired Then
Dim d As New SetTextCallback(AddressOf SetText)
Lab.Invoke(d, New Object() {Convert.ToString([text]), Lab})
Else
Lab.Text = [text]
End If
End Sub
Delegate Sub SetTextCallback(ByVal [text] As String, ByVal Lab As Label)
MainThread.Start()'執行序啟動'跨執行序呼叫元件,label 跟 button'-------------------
Public Sub SetButton(ByVal [text] As String, ByVal BTN As Button)
' InvokeRequired required compares the thread ID of the
' calling thread to the thread ID of the creating thread.
' If these threads are different, it returns true.
If BTN.InvokeRequired Then
Dim d As New SetButtonCallback(AddressOf SetButton)
BTN.Invoke(d, New Object() {Convert.ToString([text]), BTN})
Else
BTN.Text = [text]
End If
End Sub
Delegate Sub SetButtonCallback(ByVal [text] As String, ByVal BTN As Button)'----------------------------------------Label
Public Sub SetText(ByVal [text] As String, ByVal Lab As Label)
' InvokeRequired required compares the thread ID of the
' calling thread to the thread ID of the creating thread.
' If these threads are different, it returns true.
If Lab.InvokeRequired Then
Dim d As New SetTextCallback(AddressOf SetText)
Lab.Invoke(d, New Object() {Convert.ToString([text]), Lab})
Else
Lab.Text = [text]
End If
End Sub
Delegate Sub SetTextCallback(ByVal [text] As String, ByVal Lab As Label)
vb.net 日期加減法
'-----------------日期加法Dim str, str2 As String
str = "2008/05/2"
str2 = "2008/05/28"
Dim dd As String
dd = Convert.ToDateTime(str).AddDays(1)
MsgBox(dd)
'------------------日期減法
Dim str, str2 As String
str = "2008/05/2"
str2 = "2008/05/28"
Dim dd As String
dd = DateDiff(DateInterval.Day, Convert.ToDateTime(str), Convert.ToDateTime(str2)) MsgBox(dd)
str = "2008/05/2"
str2 = "2008/05/28"
Dim dd As String
dd = Convert.ToDateTime(str).AddDays(1)
MsgBox(dd)
'------------------日期減法
Dim str, str2 As String
str = "2008/05/2"
str2 = "2008/05/28"
Dim dd As String
dd = DateDiff(DateInterval.Day, Convert.ToDateTime(str), Convert.ToDateTime(str2)) MsgBox(dd)
vb.net 讀取文字檔案
Dim str1, str2 As String
Dim Cc As Integer
Dim myRead = File.ReadAllLines("c:\3000-04.txt", Encoding.UTF8)
Dim MystreamWiter As StreamWriter = New StreamWriter("c:\3000-04-02.txt", False) Cc = 0
str2 = ""
For Each str1 In myRead
'MsgBox(str1)
str2 = str2 & str1
Cc = Cc + 1
If Cc = 3 Then
MystreamWiter.WriteLine(str2)
Cc = 0
str2 = ""
End If
Next
Dim Cc As Integer
Dim myRead = File.ReadAllLines("c:\3000-04.txt", Encoding.UTF8)
Dim MystreamWiter As StreamWriter = New StreamWriter("c:\3000-04-02.txt", False) Cc = 0
str2 = ""
For Each str1 In myRead
'MsgBox(str1)
str2 = str2 & str1
Cc = Cc + 1
If Cc = 3 Then
MystreamWiter.WriteLine(str2)
Cc = 0
str2 = ""
End If
Next
攔截使用者按下表單上得『X』
Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
' 參數Message : 可實作Windows 訊息。
' Message.Msg 屬性: 取得或設定訊息的ID 編號。
' Message.WParam 屬性: 取得或設定訊息的WParam 欄位。
'點到了『X』
If m.Msg = 161 And m.WParam = 20 Then
Me.Visible = False
Else
MyBase.WndProc(m) ' 處理Windows 訊息。
End If ' MyBase : 提供方法來參考目前類別(Class) 執行個體的基底類別。
End Sub
' 參數Message : 可實作Windows 訊息。
' Message.Msg 屬性: 取得或設定訊息的ID 編號。
' Message.WParam 屬性: 取得或設定訊息的WParam 欄位。
'點到了『X』
If m.Msg = 161 And m.WParam = 20 Then
Me.Visible = False
Else
MyBase.WndProc(m) ' 處理Windows 訊息。
End If ' MyBase : 提供方法來參考目前類別(Class) 執行個體的基底類別。
End Sub
尋找所有DGV選取的CELL
Dim V_select_enum As IEnumerator 'Enum 列舉所有被選取的範圍
V_select_enum = DGV.SelectedCells.GetEnumerator
While V_select_enum.MoveNext()
If X2 < V_select_enum.Current.columnindex Then
X2 = V_select_enum.Current.columnindex
End If
If Y2 < V_select_enum.Current.rowindex Then
Y2 = V_select_enum.Current.rowindex
End If
If X1 > V_select_enum.Current.columnindex Then
X1 = V_select_enum.Current.columnindex
End If
If Y1 > V_select_enum.Current.rowindex Then
Y1 = V_select_enum.Current.rowindex
End If
End While
DGV_location1(0) = X1
DGV_location1(1) = Y1
DGV_location2(0) = X2
DGV_location2(1) = Y2
V_select_enum = DGV.SelectedCells.GetEnumerator
While V_select_enum.MoveNext()
If X2 < V_select_enum.Current.columnindex Then
X2 = V_select_enum.Current.columnindex
End If
If Y2 < V_select_enum.Current.rowindex Then
Y2 = V_select_enum.Current.rowindex
End If
If X1 > V_select_enum.Current.columnindex Then
X1 = V_select_enum.Current.columnindex
End If
If Y1 > V_select_enum.Current.rowindex Then
Y1 = V_select_enum.Current.rowindex
End If
End While
DGV_location1(0) = X1
DGV_location1(1) = Y1
DGV_location2(0) = X2
DGV_location2(1) = Y2
2008年9月7日 星期日
繪圖bar
Public Sub Gen_Box(ByVal DGV1 As DataGridView, ByVal R_index As Integer, ByVal Stime As DateTime, ByVal Etime As DateTime, ByVal TT_str As String, ByVal V_color As Brush, ByVal V_N_color As Brush)
Dim G As Graphics = DGV1.CreateGraphics
Dim Jj As Integer
Dim kk, Pp As DateTime
Dim Spoint_X, Spoint_y, Epoint_X, Epoint_Y As Integer kk = Stime.ToString("HH:mm")
Pp = Etime.ToString("HH:mm")
Jj = DateDiff(DateInterval.Minute, kk, Pp)
Spoint_X = DGV1.RowHeadersWidth + DGV1.Columns(R_index).Width * Stime.ToString("HH") + (Stime.ToString("mm") / 60 * DGV1.Columns(R_index).Width)
Spoint_y = DGV1.Rows(R_index).Height * R_index + DGV1.ColumnHeadersHeight + 1 Epoint_X = Jj / 60 * DGV1.Columns(R_index).Width Epoint_Y = DGV1.Rows(R_index).Height - 1
Dim rect As New Rectangle(Spoint_X, Spoint_y, Epoint_X, Epoint_Y) G.FillRectangle(V_color, rect)
Dim fontb As New Font("新細明體", 8, FontStyle.Bold)
G.DrawString(Stime.ToString("HH:mm") & " ~ " & Etime.ToString("HH:mm"), fontb, V_N_color, Spoint_X, Spoint_y)
End Sub
Dim G As Graphics = DGV1.CreateGraphics
Dim Jj As Integer
Dim kk, Pp As DateTime
Dim Spoint_X, Spoint_y, Epoint_X, Epoint_Y As Integer kk = Stime.ToString("HH:mm")
Pp = Etime.ToString("HH:mm")
Jj = DateDiff(DateInterval.Minute, kk, Pp)
Spoint_X = DGV1.RowHeadersWidth + DGV1.Columns(R_index).Width * Stime.ToString("HH") + (Stime.ToString("mm") / 60 * DGV1.Columns(R_index).Width)
Spoint_y = DGV1.Rows(R_index).Height * R_index + DGV1.ColumnHeadersHeight + 1 Epoint_X = Jj / 60 * DGV1.Columns(R_index).Width Epoint_Y = DGV1.Rows(R_index).Height - 1
Dim rect As New Rectangle(Spoint_X, Spoint_y, Epoint_X, Epoint_Y) G.FillRectangle(V_color, rect)
Dim fontb As New Font("新細明體", 8, FontStyle.Bold)
G.DrawString(Stime.ToString("HH:mm") & " ~ " & Etime.ToString("HH:mm"), fontb, V_N_color, Spoint_X, Spoint_y)
End Sub
訂閱：
文章 (Atom)