继续VB，并奉献几个小函数，散分

[程序员老干部]

继续用VB来写程序，C#只是拿来玩玩。
奉献几个在这个软件中的用到的小函数。
原文地址：http://blog.csdn.net/chncoder/article/details/24419253

1、获得文件的扩展名

Private Function GetExtension(Filename As String) As String   

    Dim i, j, path, Ext As Integer
    For i = Len(Filename) To 1 Step -1
        If Mid(Filename, i, 1) = "." Then
           Ext = i
           Exit For
        End If
    Next i
    If Ext = 0 Then
        Exit Function
    End If
    GetExtension = Mid(Filename, Ext + 1, Len(Filename) - Ext)
 End Function

2、以流的形式保存至数据库

Private Sub SaveToDB(nID As Long)
    Dim cn As New ADODB.Connection
    Dim Rst As New ADODB.Recordset
    Dim Mstream As New ADODB.Stream
    Dim sql As String
    Dim MediaName As String
    
    On Error GoTo err
    MediaName = Trim$(txtPath.Text)
    Set cn = GetConn
    Rst.CursorLocation = adUseClient
    sql = "select ID,SaveValue from tbFileManage where ID=" & nID
    Rst.Open sql, cn, adOpenStatic, adLockPessimistic
    Mstream.Type = adTypeBinary
    Mstream.Open
    Mstream.LoadFromFile MediaName
    Rst.Fields("SaveValue").Value = Mstream.Read
    Rst.Update
    Rst.Close
    Set Rst = Nothing
    cn.Close
    Set cn = Nothing
    Set Mstream = Nothing
    
    Exit Sub
err:
    If Rst.State <> adStateClosed Then Rst.Close
    Set Rst = Nothing
    If cn.State <> adStateClosed Then cn.Close
    Set cn = Nothing
    Set Mstream = Nothing
End Sub

3、读取数据，生成临时文件后直接打开

Private Sub ReadFromDB(nID As Long, sFullPath As String)
    Dim cn As New ADODB.Connection
    Dim Rst As New ADODB.Recordset
    Dim Mstream As ADODB.Stream
    Dim sql As String
    Dim tmpFile As String
    
    On Error GoTo err
    Set cn = GetConn
    sql = "select ID,SaveValue,FileType from tbFileManage where ID=" & nID
    Rst.CursorLocation = adUseClient
    Rst.Open sql, cn, adOpenStatic, adLockReadOnly
    If IsNull(Rst.Fields("SaveValue").Value) Then
        MsgBox "文档无内容", vbExclamation
        Rst.Close: Set Rst = Nothing
        cn.Close: Set cn = Nothing
        Exit Sub
    End If
    
    Set Mstream = New ADODB.Stream
    Mstream.Type = adTypeBinary
    Mstream.Open
    Mstream.Write Rst.Fields("SaveValue").Value
    tmpFile = sFullPath & GetGUID & "." & Rst.Fields("FileType").Value
    Mstream.SaveToFile tmpFile, adSaveCreateOverWrite
    Mstream.Close
    Set Mstream = Nothing
    Rst.Close
    cn.Close
    Set cn = Nothing
    Set Rst = Nothing
    ShellExecute Me.hwnd, "Open", tmpFile, "", App.path, 1
    Exit Sub
err:
    If Rst.State <> adStateClosed Then Rst.Close
    Set Rst = Nothing
    If cn.State <> adStateClosed Then cn.Close
    Set cn = Nothing
    Set Mstream = Nothing
    MsgBox err.Description
End Sub

[jgc517]

我也来接分！

[yachong]

接分来了 获取扩展名那个函数，为什么不用instrrev来确定小数点位置？

[酷心]

接分 获取文件扩展名的函数应该还要排除.和..和abc.和.abc这几种情况，这些只能算文件夹名，不能算文件名 也可以用PathFindExtension API函数

[tanta]

接分。感谢。

[zy19870908]

学习了！

[chuting1]

学习。。。。。。。。。

[gzbandit]

从没接到过分，试试。

[舉杯邀明月]

你的这点“奉献”，我看还是你自己留着用吧！
不要拿出来把别的菜鸟带上歪路了。
-_-!!!

[舉杯邀明月]

引用 1 楼 yachong 的回复:

接分来了 获取扩展名那个函数，为什么不用instrrev来确定小数点位置？

估计他根本就不知道那个函数。 从他的变量声明语句，就可以看出他仅仅是入门水平。

[笨狗先飞]

Public Function ExtractFileExt(FileName As String) As String        '返回文件扩展名
    Dim i As Integer, L As Integer
    i = InStrRev(FileName, ".")
    L = Len(FileName)
    If (L > i) And (i > 0) Then
        ExtractFileExt = Right(FileName, L - i)
    Else
        ExtractFileExt = ""
    End If
End Function

Public Function ExtractFilePath(FileName As String) As String       '返回特定文件的路径
    Dim i As Integer
    i = InStrRev(FileName, "\")
    If i > 0 Then
        ExtractFilePath = Left(FileName, i)
    Else
        ExtractFilePath = ""
    End If
End Function

Public Function ExtractFileName(FileName As String) As String       '从全路径名中返回文件名
    Dim i As Integer, L As Integer
    i = InStrRev(FileName, "\")
    L = Len(FileName)
    If (L > i) And (i >= 0) Then
        ExtractFileName = Right(FileName, L - i)
    Else
        ExtractFileName = ""
    End If
End Function

Public Function ChangeFileExt(FileName As String, Ext As String) As String  '改变文件扩展名
    Dim i As Integer, L As Integer
    i = InStrRev(FileName, ".")
    L = Len(FileName)
    If i > 0 Then
        ChangeFileExt = Left(FileName, i - 1) & IIf(InStr(Ext, ".") > 0, Ext, "." & Ext)
    Else
        ChangeFileExt = FileName & IIf(InStr(Ext, ".") > 0, Ext, "." & Ext)
    End If
End Function

[程序员老干部]

引用 9 楼 Chen8013 的回复:

[quote=引用 1 楼 yachong 的回复:] 接分来了 获取扩展名那个函数，为什么不用instrrev来确定小数点位置？

估计他根本就不知道那个函数。 从他的变量声明语句，就可以看出他仅仅是入门水平。[/quote] 1、我没有说明这几个函数是我写的，事实上是从这个论坛找的，只是汇总了一下，目的是为了方便大家。 2、变量声明确实有问题，除了EXT是不是都成Object了，太久没用VB，忘了，也没注意看代码，拿来就用。 3、奉献不分大小，别用引号，要不你来点大的？学学bakw。 懒得骂你。

[王二.麻子]

引用 11 楼 chncoder 的回复:

[quote=引用 9 楼 Chen8013 的回复:] [quote=引用 1 楼 yachong 的回复:] 接分来了 获取扩展名那个函数，为什么不用instrrev来确定小数点位置？

估计他根本就不知道那个函数。 从他的变量声明语句，就可以看出他仅仅是入门水平。[/quote] 1、我没有说明这几个函数是我写的，事实上是从这个论坛找的，只是汇总了一下，目的是为了方便大家。 2、变量声明确实有问题，除了EXT是不是都成Object了，太久没用VB，忘了，也没注意看代码，拿来就用。 3、奉献不分大小，别用引号，要不你来点大的？学学bakw。 懒得骂你。[/quote] 哎呀，好像上火了。 混个分而已

[舉杯邀明月]

引用 12 楼 spt_petrolor 的回复:

[quote=引用 11 楼 chncoder 的回复:] [quote=引用 9 楼 Chen8013 的回复:] [quote=引用 1 楼 yachong 的回复:] 接分来了 获取扩展名那个函数，为什么不用instrrev来确定小数点位置？

估计他根本就不知道那个函数。 从他的变量声明语句，就可以看出他仅仅是入门水平。[/quote] 1、我没有说明这几个函数是我写的，事实上是从这个论坛找的，只是汇总了一下，目的是为了方便大家。 2、变量声明确实有问题，除了EXT是不是都成Object了，太久没用VB，忘了，也没注意看代码，拿来就用。 3、奉献不分大小，别用引号，要不你来点大的？学学bakw。 懒得骂你。[/quote] 哎呀，好像上火了。 混个分而已[/quote] 切！见不得别人对你有反对意见？ 不管是你自己写的，还是别人写的，要拿来分享，就要有指导、提升的作用。 象这种只能扯别人后腿的代码，你还好意思拿出手？？？ 我现在只是偶尔来看看，电脑在春节带回老家去了，现在用的手机上网。 难道还要我在手机上敲代码？ 如果不是很有必要的时候，谁有心思用手机敲代码！！！ 何况你这个不是来求教，是来显摆的。并且还是Copy来的垃圾代码！ 要说“奉献”，我早就有一些东西发布了，你是不懂？还是装瞎？ 要不是VB版块太冷清了，去年我还会发布一些代码， 比如实现单实例运行（有4种方法。不是用App.Prexxxx那个属性，这个属性基本上无用） 比如 用VB6写StdCall的dll时，如何传递字符串、数组（主要是跟其它语言接口时，仅用在 vb6中无需处理），如何在dll的过程中创建对象、使用窗口（不进行技术处理，无法实现）等。 看到我给你这贴子泼冷水，就要骂人了？ 凭你这样的素质，一辈子都不会有出息！