Hanse 发布的文章

方法一

Public Function getWebSource(ByVal url As String) As String
    Try
        Dim stream As IO.Stream = WebRequest.Create(url).GetResponse().GetResponseStream()
        Dim sr As StreamReader = New StreamReader(stream, System.Text.Encoding.UTF8)
        Return sr.ReadToEnd()
    Catch ex As Exception
        Return ""
        'Return ex.ToString()
    End Try
End Function

方法二

节选自网络,实测较慢

Public Function GetWebCode(ByVal strURL As String) As String
    Dim httpReq As System.Net.HttpWebRequest
    Dim httpResp As System.Net.HttpWebResponse
    Dim httpURL As New System.Uri(strURL)
    Dim ioS As System.IO.Stream, charSet As String, tCode As String
    Dim k() As Byte
    ReDim k(0)
    Dim dataQue As New Queue(Of Byte)
    httpReq = CType(WebRequest.Create(httpURL), HttpWebRequest)
    Dim sTime As Date = CDate("1990-09-21 00:00:00")
    httpReq.IfModifiedSince = sTime
    httpReq.Method = "GET"
    httpReq.Timeout = 7000

    Try
        httpResp = CType(httpReq.GetResponse(), HttpWebResponse)
    Catch
        Debug.Print("weberror")
        GetWebCode = "<title>no thing found</title>" : Exit Function
    End Try
    '以上为网络数据获取
    ioS = CType(httpResp.GetResponseStream, Stream)
    Do While ioS.CanRead = True
        Try
            dataQue.Enqueue(ioS.ReadByte)
        Catch
            Debug.Print("read error")
            Exit Do
        End Try
    Loop
    ReDim k(dataQue.Count - 1)
    For j As Integer = 0 To dataQue.Count - 1
        k(j) = dataQue.Dequeue
    Next
    '以上,为获取流中的的二进制数据
    tCode = Encoding.GetEncoding("UTF-8").GetString(k) '获取特定编码下的情况,毕竟UTF-8支持英文正常的显示
    charSet = Replace(GetByDiv2(tCode, "charset=", """"), """", "") '进行编码类型识别
    '以上,获取编码类型
    If charSet = "" Then 'defalt
        If httpResp.CharacterSet = "" Then
            tCode = Encoding.GetEncoding("UTF-8").GetString(k)
        Else
            tCode = Encoding.GetEncoding(httpResp.CharacterSet).GetString(k)
        End If
    Else
        tCode = Encoding.GetEncoding(charSet).GetString(k)
    End If
    Debug.Print(charSet)
    'Stop
    '以上,按照获得的编码类型进行数据转换
    '将得到的内容进行最后处理,比如判断是不是有出现字符串为空的情况
    GetWebCode = tCode
    If tCode = "" Then GetWebCode = "<title>no thing found</title>"
End Function

Public Function GetByDiv2(ByVal code As String, ByVal divBegin As String, ByVal divEnd As String) '获取分隔符所夹的内容[完成,未测试]
'仅用于获取编码数据
    Dim lgStart As Integer
    Dim lens As Integer
    Dim lgEnd As Integer
    lens = Len(divBegin)
    If InStr(1, code, divBegin) = 0 Then GetByDiv2 = "" : Exit Function
    lgStart = InStr(1, code, divBegin) + CInt(lens)

    lgEnd = InStr(lgStart + 1, code, divEnd)
    If lgEnd = 0 Then GetByDiv2 = "" : Exit Function
    GetByDiv2 = Mid(code, lgStart, lgEnd - lgStart)
End Function

摘自项目FXB:

Private Sub MainForm_DragDrop(sender As Object, e As DragEventArgs) Handles MyBase.DragDrop
    Dim Files(), Temp() As String
    Files = e.Data.GetData(DataFormats.FileDrop)
    Temp = Split(Files(0), ".")
    If UCase(Temp(UBound(Temp))) = "XLSX" Or UCase(Temp(UBound(Temp))) = "XLS" Then
        MsgBox(Files(0))
    Else
        MsgBox("非Excel文件!", MsgBoxStyle.Exclamation)
    End If
    End Sub

    Private Sub MainForm_DragEnter(sender As Object, e As DragEventArgs) Handles MyBase.DragEnter
    If e.Data.GetDataPresent(DataFormats.FileDrop) = True Then
        e.Effect = DragDropEffects.Link
    Else
        e.Effect = DragDropEffects.None
    End If
End Sub

摘自网络:

Private Sub MainForm_Load(sender As Object, e As EventArgs) Handles MyBase.Load
    SellList.DrawMode = DrawMode.OwnerDrawFixed
    SellList.Items.AddRange(New String() {"第一", "第二", "第三"})
End Sub

Private Sub SellList_DrawItem(sender As Object, e As DrawItemEventArgs) Handles SellList.DrawItem
    'Dim lb As ListBox = CType(sender, ListBox)
    If e.Index = -1 Then
        Return
    End If

    If e.Index = 2 Then
        e.Graphics.DrawString(SellList.Items(e.Index), SellList.Font, Brushes.Red, e.Bounds.X, e.Bounds.Y)
    Else
        e.Graphics.DrawString(SellList.Items(e.Index), SellList.Font, Brushes.Green, e.Bounds.X, e.Bounds.Y)
    End If
End Sub

简单查找第一个匹配值

Public Function getFirstReg(ByVal searchStr As String, ByVal regStr As String) As String
    Try
        Dim r As New Regex(regStr)
        Dim m As Match = r.Match(searchStr)
        If m.Success Then
            Return m.Value
        Else
            Return ""
        End If
    Catch ex As Exception
        Return ""
    End Try
End Function

替换字符

Public Function regReplace(ByVal searchStr As String, ByVal replaceStr As String, ByVal regStr As String) As String
    Dim reg As New Regex(regStr)
    Dim result As String = reg.Replace(searchStr, replaceStr)
    Return result
End Function