vbtips7.htm

所有我收藏的VB技巧

        (ByVal pidList As Long, ByVal lpBuffer As String) As Long<br>
        函数：<br>
        Public Function BrowseForFolder(hWndOwner As Long,
        sPrompt As String) As String<br>
        <br>
        Dim iNull As Integer<br>
        Dim lpIDList As Long<br>
        Dim lResult As Long<br>
        Dim sPath As String<br>
        Dim udtBI As BrowseInfo<br>
        <br>
        With udtBI<br>
        .hWndOwner = hWndOwner<br>
        .lpszTitle = lstrcat(sPrompt, &quot;&quot;)<br>
        .ulFlags = BIF_RETURNONLYFSDIRS<br>
        End With<br>
        <br>
        lpIDList = SHBrowseForFolder(udtBI)<br>
        If lpIDList Then<br>
        sPath = String$(MAX_PATH, 0)<br>
        lResult = SHGetPathFromIDList(lpIDList, sPath)<br>
        Call CoTaskMemFree(lpIDList)<br>
        iNull = InStr(sPath, vbNullChar)<br>
        If iNull Then<br>
        sPath = Left$(sPath, iNull - 1)<br>
        End If<br>
        End If<br>
        <br>
        BrowseForFolder = sPath<br>
        <br>
        End Function<br>
        <a href="#home"><font color="#000000">返回</font></a></p>
        <p><a name="tips04"></a><strong>移动文件到回收站</strong><br>
        声明：<br>
        Public Type SHFILEOPSTRUCT<br>
        hwnd As Long<br>
        wFunc As Long<br>
        pFrom As String<br>
        pTo As String<br>
        fFlags As Integer<br>
        fAnyOperationsAborted As Long<br>
        hNameMappings As Long<br>
        lpszProgressTitle As Long<br>
        End Type<br>
        <br>
        Public Declare Function SHFileOperation Lib _<br>
        &quot;shell32.dll&quot; Alias
        &quot;SHFileOperationA&quot; (lpFileOp _<br>
        As SHFILEOPSTRUCT) As Long<br>
        <br>
        Public Const FO_DELETE = &amp;H3<br>
        Public Const FOF_ALLOWUNDO = &amp;H40 <br>
        代码：<br>
        Dim SHop As SHFILEOPSTRUCT<br>
        Dim strFile as string<br>
        <br>
        With SHop<br>
        .wFunc = FO_DELETE<br>
        .pFrom = strFile + Chr(0)<br>
        .fFlags = FOF_ALLOWUNDO<br>
        End With<br>
        <a href="#home"><font color="#000000">返回</font></a></p>
        <p><a name="tips05"></a><strong>比较两个文件</strong><br>
        Function CompFile(F1 as string, F2 as string) as boolean<br>
        Dim issame as boolean<br>
        Open F1 For Binary As #1 <br>
        Open F2 For Binary As #2 <br>
        <br>
        issame = True<br>
        If LOF(1) &lt;&gt; LOF(2) Then <br>
        issame = False <br>
        Else<br>
        whole&amp; = LOF(1) \ 10000 'number of whole 10,000 byte
        chunks<br>
        part&amp; = LOF(1) Mod 10000 'remaining bytes at end of
        file<br>
        buffer1$ = String$(10000, 0) <br>
        buffer2$ = String$(10000, 0) <br>
        start&amp; = 1<br>
        For x&amp; = 1 To whole&amp; 'this for-next loop will get
        10,000<br>
        Get #1, start&amp;, buffer1$ 'byte chunks at a time.<br>
        Get #2, start&amp;, buffer2$ <br>
        If buffer1$ &lt;&gt; buffer2$ Then <br>
        issame = False<br>
        Exit For <br>
        End If <br>
        start&amp; = start&amp; + 10000 <br>
        Next<br>
        buffer1$ = String$(part&amp;, 0) <br>
        buffer2$ = String$(part&amp;, 0)<br>
        Get #1, start&amp;, buffer1$ 'get the remaining bytes at
        the end<br>
        Get #2, start&amp;, buffer2$ 'get the remaining bytes at
        the end<br>
        If buffer1$ &lt;&gt; buffer2$ Then <br>
        issame = False <br>
        End If <br>
        Close <br>
        CompFile = issame<br>
        End Function<br>
        <a href="#home"><font color="#000000">返回</font></a></p>
        <p><a name="tips06"></a><strong>取得临时文件名</strong><br>
        声明：<br>
        Public Const MAX_PATH = 260<br>
        <br>
        Public Declare Function GetTempFileName Lib
        &quot;kernel32&quot; Alias &quot;GetTempFileNameA&quot;
        (ByVal lpszPath As String, ByVal lpPrefixString As
        String, ByVal wUnique As Long, ByVal lpTempFileName As
        String) As Long<br>
        Public Declare Function GetTempPath Lib
        &quot;kernel32&quot; Alias &quot;GetTempPathA&quot;
        (ByVal nBufferLength As Long, ByVal lpBuffer As String)
        As Long<br>
        <br>
        代码：<br>
        Public Function GetTempFile() As String<br>
        Dim lngRet As Long<br>
        Dim strBuffer As String, strTempPath As String<br>
        <br>
        '初始化 buffer<br>
        strBuffer = String$(MAX_PATH, 0)<br>
        <br>
        '取得临时路径<br>
        lngRet = GetTempPath(Len(strBuffer), strBuffer)<br>
        <br>
        '0 错误<br>
        If lngRet = 0 Then Exit Function<br>
        <br>
        '去掉尾中的 null<br>
        strTempPath = Left$(strBuffer, lngRet)<br>
        <br>
        '初始化 buffer<br>
        strBuffer = String$(MAX_PATH, 0)<br>
        <br>
        '取得临时文件名<br>
        lngRet = GetTempFileName(strTempPath, &quot;tmp&quot;,
        0&amp;, strBuffer)<br>
        <br>
        If lngRet = 0 Then Exit Function<br>
        <br>
        lngRet = InStr(1, strBuffer, Chr(0))<br>
        If lngRet &gt; 0 Then<br>
        GetTempFile = Left$(strBuffer, lngRet - 1)<br>
        Else<br>
        GetTempFile = strBuffer<br>
        End If<br>
        End Function<br>
        <a href="#home"><font color="#000000">返回</font></a></p>
        <p><a name="tips07"></a><strong>确定是 WINDOWS
        的可执行文件</strong><br>
        在文件的第 24 字节，如果为40h，就是 Windows
        的可执行文件。<br>
        <br>
        Function WinExe (ByVal Exe As String) As Integer<br>
        Dim fh As Integer<br>
        Dim t As String * 1<br>
        fh = FreeFile<br>
        Open Exe For Binary As #fh<br>
        Get fh, 25, t<br>
        Close #fh<br>
        WinExe = (Asc(t) = &amp;H40&amp;)<br>
        End Function<br>
        <a href="#home"><font color="#000000">返回</font></a></p>
        <p><a name="tips08"></a><strong>建立多级目录</strong><br>
        Sub CreateLongDir(sDrive As String, sDir As String)<br>
        Dim sBuild As String<br>
        <br>
        While InStr(2, sDir, &quot;\&quot;) &gt; 1<br>
        sBuild = sBuild &amp; left(sDir, InStr(2, sDir,
        &quot;\&quot;) - 1)<br>
        sDir = Mid(sDir, InStr(2, sDir, &quot;\&quot;))<br>
        If Dir(sDrive &amp; sBuild, 16) = &quot;&quot; Then<br>
        MkDir sDrive &amp; sBuild<br>
        End If<br>
        Wend<br>
        End Sub<br>
        <a href="#home"><font color="#000000">返回</font></a></p>
        <p><a name="tips09"></a><strong>取得文件的扩展名</strong><br>
        Function GetExtension(Filename As String)<br>
        Dim PthPos, ExtPos As Integer<br>
        <br>
        For i = Len(Filename) To 1 Step -1 ' Go from the Length
        of the filename, to the first character by 1.<br>
        If Mid(Filename, i, 1) = &quot;.&quot; Then ' If the
        current position is '.' then...<br>
        ExtPos = i ' ...Change the ExtPos to the number.<br>
        For j = Len(Filename) To 1 Step -1 ' Do the Same...<br>
        If Mid(Filename, j, 1) = &quot;\&quot; Then ' ...but for
        '\'.<br>
        PthPos = j ' Change the PthPos to the number.<br>
        Exit For ' Since we found it, don't search any more.<br>
        End If<br>
        Next j<br>
        Exit For ' Since we found it, don't search any more.<br>
        End If<br>
        Next i<br>
        <br>
        If PthPos &gt; ExtPos Then<br>
        Exit Function ' No extension.<br>
        Else<br>
        If ExtPos = 0 Then Exit Function ' If there is not
        extension, then exit sub.<br>
        GetExtension = Mid(Filename, ExtPos + 1, Len(Filename) -
        ExtPos) 'Messagebox the Extension<br>
        End If<br>
        <br>
        End Function<br>
        使用：<br>
        FileExt = GetExtension(&quot;c:\windows\vb\vb.exe&quot;)<br>
        <a href="#home"><font color="#000000">返回</font></a></p>
        </td>
    </tr>
</table>
</center></div>

<hr>
<div align="center"><center>

<table border="0" cellspacing="1" width="88%">
    <tr>
        <td width="80%"><p align="left"><a
        href="vbtips.htm#Return">[1]</a> <a href="vbtips1.htm">[2]</a>
        <a href="vbtips2.htm">[3]</a> <a href="vbtips3.htm">[4]</a>
        <a href="vbtips4.htm">[5]</a> <a href="vbtips5.htm">[6]</a>
        [7] <a href="vbtips08.htm">[8]</a> <a href="vbtips9.htm">[9]</a>
        <a href="vbtips10.htm">[10]</a></p>
        </td>
        <td><p align="right"><font size="2">第七页(共十页)</font></p>
        </td>
    </tr>
</table>
</center></div>
</body>
</html>