巴顿专贴（第二号）：用于回答各位的问题，请各位提问，来者有分

Question

谢谢大家，先放一个标准FTP类：Option Explicit
'
' 标准 FTP Class
'
' This class wraps the functionality of the Win32 WinInet.DLL
'
' It could easily be expanded to provide HTTP/Gopher and other internet
' standard file protocols.
'Private Const MAX_PATH = 260Private Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
End TypePrivate Type WIN32_FIND_DATA
        dwFileAttributes As Long
        ftCreationTime As FILETIME
        ftLastAccessTime As FILETIME
        ftLastWriteTime As FILETIME
        nFileSizeHigh As Long
        nFileSizeLow As Long
        dwReserved0 As Long
        dwReserved1 As Long
        cFileName As String * MAX_PATH
        cAlternate As String * 14
End Type
Private Const ERROR_NO_MORE_FILES = 18
Private Declare Function InternetFindNextFile Lib "wininet.dll" Alias "InternetFindNextFileA" (ByVal hFind As Long, lpvFindData As WIN32_FIND_DATA) As Long
    
Private Declare Function FtpFindFirstFile Lib "wininet.dll" Alias "FtpFindFirstFileA" (ByVal hFtpSession As Long, ByVal lpszSearchFile As String, lpFindFileData As WIN32_FIND_DATA, ByVal dwFlags As Long, ByVal dwContent As Long) As LongPrivate Declare Function FtpGetFile Lib "wininet.dll" Alias "FtpGetFileA" (ByVal hFtpSession As Long, ByVal lpszRemoteFile As String, ByVal lpszNewFile As String, ByVal fFailIfExists As Boolean, ByVal dwFlagsAndAttributes As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As BooleanPrivate Declare Function FtpPutFile Lib "wininet.dll" Alias "FtpPutFileA" (ByVal hFtpSession As Long, ByVal lpszLocalFile As String, ByVal lpszRemoteFile As String, ByVal dwFlags As Long, ByVal dwContext As Long) As BooleanPrivate Declare Function FtpSetCurrentDirectory Lib "wininet.dll" Alias "FtpSetCurrentDirectoryA" (ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean
' Initializes an application's use of the Win32 Internet functions
Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long' Use registry access settings.
Private Const INTERNET_OPEN_TYPE_DIRECT = 1
Private Const INTERNET_OPEN_TYPE_PROXY = 3
Private Const INTERNET_INVALID_PORT_NUMBER = 0Private Const FTP_TRANSFER_TYPE_ASCII = &H1
Private Const FTP_TRANSFER_TYPE_BINARY = &H2
Private Const FTP_TRANSFER_TYPE_UNKNOWN = &H0Private Const INTERNET_FLAG_PASSIVE = &H8000000Private Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" (ByVal hInternetSession As Long, ByVal sServerName As String, ByVal nServerPort As Integer, ByVal sUserName As String, ByVal sPassword As String, ByVal lService As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Const ERROR_INTERNET_EXTENDED_ERROR = 12003Private Declare Function InternetGetLastResponseInfo Lib "wininet.dll" Alias "InternetGetLastResponseInfoA" (lpdwError As Long, ByVal lpszBuffer As String, lpdwBufferLength As Long) As Boolean' Type of service to access.
Private Const INTERNET_SERVICE_FTP = 1
'private Const INTERNET_SERVICE_GOPHER = 2
'private Const INTERNET_SERVICE_HTTP = 3Private Const INTERNET_FLAG_RELOAD = &H80000000
Private Const INTERNET_FLAG_KEEP_CONNECTION = &H400000
Private Const INTERNET_FLAG_MULTIPART = &H200000Private Declare Function FtpOpenFile Lib "wininet.dll" Alias "FtpOpenFileA" (ByVal hFtpSession As Long, ByVal sFileName As String, ByVal lAccess As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Function FtpDeleteFile Lib "wininet.dll" Alias "FtpDeleteFileA" (ByVal hFtpSession As Long, ByVal lpszFileName As String) As Boolean
    
Private Declare Function FtpRenameFile Lib "wininet.dll" Alias "FtpRenameFileA" (ByVal hFtpSession As Long, ByVal sExistingName As String, ByVal sNewName As String) As Boolean
   
' Closes a single Internet handle or a subtree of Internet handles.
Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer
'
' Our Defined Errors
'
Public Enum errFtpErrors
    errCannotConnect = vbObjectError + 2001
    errNoDirChange = vbObjectError + 2002
    errCannotRename = vbObjectError + 2003
    errCannotDelete = vbObjectError + 2004
    errNotConnectedToSite = vbObjectError + 2005
    errGetFileError = vbObjectError + 2006
    errInvalidProperty = vbObjectError + 2007
    errFatal = vbObjectError + 2008
End Enum'
' File Transfer types
'
Public Enum FileTransferType
    ftAscii = FTP_TRANSFER_TYPE_ASCII
    ftBinary = FTP_TRANSFER_TYPE_BINARY
    ftUnknown = FTP_TRANSFER_TYPE_UNKNOWN
End Enum'
' Error messages
'
Private Const ERRCHANGEDIRSTR As String = "无法切换到目录 %s。 可能此目录不存在, 或者写保护！"
Private Const ERRCONNECTERROR As String = "无法用提供的用户名与密码连接到服务器 %s "
Private Const ERRNOCONNECTION As String = "没有连接到 FTP Site"
Private Const ERRNODOWNLOAD As String = "无法从服务上获取文件 %s "
Private Const ERRNORENAME As String = "无法重命名文件 %s"
Private Const ERRNODELETE As String = "无法删除服务器上的文件 %s "
Private Const ERRALREADYCONNECTED As String = "不能在连接到FTP服务器时修改此属性！"
Private Const ERRFATALERROR As String = "无法接服务器!"'
' Session Identifier to Windows
'
Private Const SESSION As String = "CGFtp Instance"
'
' Our INET handle
'
Private mlINetHandle As Long
'
' Our FTP Connection Handle
'
Private mlConnection As Long
'
' Standard FTP properties for this class
'
Private msHostAddress As String
Private msUser As String
Private msPassword As String
Private msDirectory As StringPrivate Sub Class_Initialize()
'
' Create Internet session handle
'
    mlINetHandle = InternetOpen(SESSION, INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
    
    If mlINetHandle = 0 Then
        mlConnection = 0
        Err.Raise errFatal, "CGFTP::Class_Initialise", ERRFATALERROR
    End If
    
    mlConnection = 0
    
End Sub
Private Sub Class_Terminate()
'
' Kill off any connection
'
    If mlConnection <> 0 Then
        InternetCloseHandle mlConnection
    End If
'
' Kill off API Handle
'
    If mlINetHandle <> 0 Then
        InternetCloseHandle mlINetHandle
    End If
    mlConnection = 0
    mlINetHandle = 0
    
End SubPublic Property Let Host(ByVal sHostName As String)
'
' Set the Host Name - only if not connected
'
    If mlConnection <> 0 Then
        Err.Raise errInvalidProperty, "ACNFTP:Host_Let", ERRALREADYCONNECTED
        
    End If
    msHostAddress = sHostName
End PropertyPublic Property Get Host() As String
'
' Get Host Name
'
    Host = msHostAddress
End PropertyPublic Property Let User(ByVal sUserName As String)
'
' Set the user - only if not connected
'
    If mlConnection <> 0 Then
        Err.Raise errInvalidProperty, "CGFTP::User_Let", ERRALREADYCONNECTED
        
    End If
    msUser = sUserName
End PropertyPublic Property Get User() As String
'
' Get the user information
'
    User = msUser
End PropertyPublic Property Let Password(ByVal sPassword As String)
'
' Set the password - only if not connected
'
    If mlConnection <> 0 Then
        Err.Raise errInvalidProperty, "CGFTP::Password_Let", ERRALREADYCONNECTED
        
    End If
    msPassword = sPassword
End PropertyPublic Property Get Password() As String
'
' Get the password
'
    Password = msPassword
End PropertyPublic Property Get Directory() As String
'
' Get the directory
'
    Directory = msDirectory
End PropertyPublic Property Let Directory(ByVal sDirectory As String)
'
' Set the directory - only if connected
'
On Error GoTo vbErrorHandler    Dim sError As String
    
    If Not (mlConnection = 0) Then
        RemoteChDir sDirectory
        msDirectory = sDirectory
    Else
        On Error GoTo 0
        Err.Raise errNotConnectedToSite, "CGFTP::Directory_Let", ERRNOCONNECTION
    End If    Exit PropertyvbErrorHandler:
    
    Err.Raise errNoDirChange, "CGFTP::Directory[Let]", Err.Description
    
End PropertyPublic Property Get Connected() As Boolean
'
' Are we connected to an FTP Server ? T/F
'
    Connected = (mlConnection <> 0)
End PropertyPublic Function Connect(Optional Host As String, _
    Optional User As String, _
    Optional Password As String) As Boolean
'
' Connect to the FTP server
'
On Error GoTo vbErrorHandler    Dim sError As String
'
' If we already have a connection then raise an error
'
    If mlConnection <> 0 Then
        On Error GoTo 0
        Err.Raise errInvalidProperty, "CGFTP::Connect", "You are already connected to FTP Server " & msHostAddress
        Exit Function
    End If
'
' Overwrite any existing properties if they were supplied in the
' arguments to this method
'
    If Len(Host) > 0 Then
        msHostAddress = Host
    End If
    
    If Len(User) > 0 Then
        msUser = User
    End If
    
    If Len(Password) > 0 Then
        msPassword = Password
    End If'
' Connect !
'    If Len(msHostAddress) = 0 Then
        Err.Raise errInvalidProperty, "CGFTP::Connect", "No Host Address Specified!"
    End If
    
    mlConnection = InternetConnect(mlINetHandle, msHostAddress, INTERNET_INVALID_PORT_NUMBER, _
        msUser, msPassword, INTERNET_SERVICE_FTP, 0, 0)
'
' Check for connection errors
'
    If mlConnection = 0 Then
        sError = Replace(ERRCONNECTERROR, "%s", msHostAddress)
        On Error GoTo 0
        sError = sError & vbCrLf & GetINETErrorMsg(Err.LastDllError)
        Err.Raise errCannotConnect, "CGFTP::Connect", sError
    End If
    
    Connect = True    Exit FunctionvbErrorHandler:    Err.Raise Err.Number, "cFTP::Connect", Err.Description
    
End FunctionPublic Function Disconnect() As Boolean
'
' Disconnect, only if connected !
'
    If mlConnection <> 0 Then
        InternetCloseHandle mlConnection
        mlConnection = 0
    Else
        Err.Raise errNotConnectedToSite, "CGFTP::Disconnect", ERRNOCONNECTION
    End If
    msHostAddress = ""
    msUser = ""
    msPassword = ""
    msDirectory = ""
            
End Function
Public Function GetDirectoryList(Optional Directory As String, Optional FilterString As String) As ADOR.Recordset
'
' Returns a Disconnected record set for the
' directory and filterstring
'
' eg.  "/NTFFiles", "*.ntf"
'
On Error GoTo vbErrorHandler    Dim oFileColl As Collection
    Dim lFind As Long
    Dim lLastError As Long
    Dim lPtr As Long
    Dim pData As WIN32_FIND_DATA
    Dim sFilter As String
    Dim lError As Long
    Dim bRet As Boolean
    Dim sItemName As String
    Dim oRS As ADOR.Recordset
    
'
' Check if already connected, else raise an error
'
    If mlConnection = 0 Then
        Err.Raise errNotConnectedToSite, "CGFTP::GetDirectoryList", ERRNOCONNECTION
    End If'
' Build the disconnected recordset structure.
'
    Set oRS = New ADOR.Recordset
    oRS.CursorLocation = adUseClient
    oRS.Fields.Append "Name", adBSTR
    oRS.Open
'
' Change directory if required
'
    If Len(Directory) > 0 Then
        RemoteChDir Directory
    End If
    
    pData.cFileName = String$(MAX_PATH, vbNullChar)
    
    If Len(FilterString) > 0 Then
        sFilter = FilterString
    Else
        sFilter = "*.*"
    End If
    
    'Show Status on MainForm
    CStat.ShowChange TIDataShunt, SCTaskWorking'
' Get the first file in the directory
'
    lFind = FtpFindFirstFile(mlConnection, sFilter, pData, 0, 0)
    lLastError = Err.LastDllError
'
' If no files, then return an empty recordset.
'
    If lFind = 0 Then
        If lLastError = ERROR_NO_MORE_FILES Then
        ' Empty directory
            Set GetDirectoryList = oRS
            Exit Function
        Else
            On Error GoTo 0
            Err.Raise lLastError, "cFTP::GetDirectoryList", "Error looking at directory " & Directory & "\" & FilterString
        End If
        Exit Function
    End If
'
' Add the first found file into the recordset
'
    sItemName = Left$(pData.cFileName, InStr(1, pData.cFileName, vbNullChar, vbBinaryCompare) - 1)
    oRS.AddNew "Name", sItemName
'
' Get the rest of the files in the list
'
    Do
        pData.cFileName = String(MAX_PATH, vbNullChar)
        bRet = InternetFindNextFile(lFind, pData)
        If Not (bRet) Then
            lLastError = Err.LastDllError
            If lLastError = ERROR_NO_MORE_FILES Then
                Exit Do
            Else
                InternetCloseHandle lFind
                On Error GoTo 0
                Err.Raise lLastError, "cFTP::GetDirectoryList", "Error looking at directory " & Directory & "\" & FilterString
                Exit Function
            End If
        Else
            sItemName = Left$(pData.cFileName, InStr(1, pData.cFileName, vbNullChar, vbBinaryCompare) - 1)
            oRS.AddNew "Name", sItemName
            
            'Show Status on MainForm
            CStat.ShowChange TIDataShunt, SCTaskWorking        End If
    Loop
'
' Close the 'find' handle
'
    InternetCloseHandle lFind
                
    On Error Resume Next
    oRS.MoveFirst
    Err.Clear
    On Error GoTo 0
    
       Set GetDirectoryList = oRS
    
    Exit FunctionvbErrorHandler:
'
' Tidy up & raise an error
'
    If lFind <> 0 Then
        InternetCloseHandle lFind
    End If
    Set GetDirectoryList = oRS
    
    Err.Raise Err.Number, "cFTP::GetDirectoryList", Err.Description
End FunctionPublic Function GetFile(ByVal ServerFileAndPath As String, ByVal DestinationFileAndPath As String, Optional TransferType As FileTransferType = ftAscii) As Boolean
'
' Get the specified file to the desired location using the specified
' file transfer type
'
    Dim bRet As Boolean
    Dim sFileRemote As String
    Dim sDirRemote As String
    Dim sFileLocal As String
    Dim sTemp As String
    Dim lPos As Long
    Dim sError As StringOn Error GoTo vbErrorHandler
    ServerFileAndPath = IIf(Left(ServerFileAndPath, 1) = "/", ServerFileAndPath, "/" & ServerFileAndPath)
'
' If not connected, raise an error
'
    If mlConnection = 0 Then
        On Error GoTo 0
        Err.Raise errNotConnectedToSite, "CGFTP::GetFile", ERRNOCONNECTION
    End If
    
'Show Status on MainForm
    CStat.ShowChange TIDataShunt, SCTaskWorking    
'
' Get the file
'
    bRet = FtpGetFile(mlConnection, ServerFileAndPath, DestinationFileAndPath, False, INTERNET_FLAG_RELOAD, TransferType, 0)
    
    If bRet = False Then
        sError = ERRNODOWNLOAD
        sError = Replace(sError, "%s", ServerFileAndPath)
        On Error GoTo 0
        GetFile = False
        Err.Raise errGetFileError, "CGFTP::GetFile", sError
    End If
    
'Show Status on MainForm
    CStat.ShowChange TIDataShunt, SCTaskWorking    
    
    GetFile = True    Exit FunctionvbErrorHandler:
    GetFile = False
    Err.Raise errGetFileError, "cFTP::GetFile", Err.Description
    
End FunctionPublic Function PutFile(ByVal LocalFileAndPath As String, ByVal ServerFileAndPath As String, Optional TransferType As FileTransferType) As Boolean
    Dim bRet As Boolean
    Dim sFileRemote As String
    Dim sDirRemote As String
    Dim sFileLocal As String
    Dim sTemp As String
    Dim lPos As Long
    Dim sError As StringOn Error GoTo vbErrorHandler
'
' If not connected, raise an error!
'
    If mlConnection = 0 Then
        On Error GoTo 0
        Err.Raise errNotConnectedToSite, "CGFTP::PutFile", ERRNOCONNECTION
    End If    bRet = FtpPutFile(mlConnection, LocalFileAndPath, ServerFileAndPath, _
        TransferType, 0)
        
    If bRet = False Then
        sError = ERRNODOWNLOAD
        sError = Replace(sError, "%s", ServerFileAndPath)
        On Error GoTo 0
        PutFile = False
        sError = sError & vbCrLf & GetINETErrorMsg(Err.LastDllError)
        Err.Raise errCannotRename, "CGFTP::PutFile", sError
    End If
    
    PutFile = True    Exit FunctionvbErrorHandler:
    Err.Raise Err.Number, "cFTP::PutFile", Err.DescriptionEnd FunctionPublic Function RenameFile(ByVal ExistingName As String, ByVal NewName As String) As Boolean
    Dim bRet As Boolean
    Dim sError As StringOn Error GoTo vbErrorHandler
'
' If not connected, raise an error
'
    If mlConnection = 0 Then
        On Error GoTo 0
        Err.Raise errNotConnectedToSite, "CGFTP::RenameFile", ERRNOCONNECTION
    End If
   
    bRet = FtpRenameFile(mlConnection, ExistingName, NewName)
'
' Raise an error if we couldn't rename the file (most likely that
' a file with the new name already exists
'
    If bRet = False Then
        sError = ERRNORENAME
        sError = Replace(sError, "%s", ExistingName)
        On Error GoTo 0
        RenameFile = False
        sError = sError & vbCrLf & GetINETErrorMsg(Err.LastDllError)
        Err.Raise errCannotRename, "CGFTP::RenameFile", sError
    End If
    
    RenameFile = True
        Exit FunctionvbErrorHandler:
    Err.Raise Err.Number, "cFTP::RenameFile", Err.DescriptionEnd FunctionPublic Function DeleteFile(ByVal ExistingName As String) As Boolean
    Dim bRet As Boolean
    Dim sError As StringOn Error GoTo vbErrorHandler
'
' Check for a connection
'
    If mlConnection = 0 Then
        On Error GoTo 0
        Err.Raise errNotConnectedToSite, "CGFTP::DeleteFile", ERRNOCONNECTION    End If
    
    bRet = FtpDeleteFile(mlConnection, ExistingName)
'
' Raise an error if the file couldn't be deleted
'
    If bRet = False Then
        sError = ERRNODELETE
        sError = Replace(sError, "%s", ExistingName)
        On Error GoTo 0
        Err.Raise errCannotDelete, "CGFTP::DeleteFile", sError    End If
    
    DeleteFile = True    Exit FunctionvbErrorHandler:
    Err.Raise Err.Number, "cFTP::DeleteFile", Err.DescriptionEnd FunctionPrivate Sub RemoteChDir(ByVal sDir As String)
On Error GoTo vbErrorHandler
'
' Remote Change Directory Command through WININET
'
    Dim sPathFromRoot As String
    Dim bRet As Boolean
    Dim sError As String
'
' Needs standard Unix Convention
'
    sDir = Replace(sDir, "\", "/")
'
' Check for a connection
'
    If mlConnection = 0 Then
        On Error GoTo 0
        Err.Raise errNotConnectedToSite, "CGFTP::RemoteChDir", ERRNOCONNECTION        Exit Sub
    End If
    
    If Len(sDir) = 0 Then
        Exit Sub
    Else
        sPathFromRoot = sDir
        If Len(sPathFromRoot) = 0 Then
            sPathFromRoot = "/"
        End If
        bRet = FtpSetCurrentDirectory(mlConnection, sPathFromRoot)
'
' If we couldn't change directory - raise an error
'
        If bRet = False Then
            sError = ERRCHANGEDIRSTR
            sError = Replace(sError, "%s", sDir)
            On Error GoTo 0
            Err.Raise errNoDirChange, "CGFTP::ChangeDirectory", sError
           
        End If
    End If    Exit SubvbErrorHandler:
    Err.RaiseErr.Number, "cFTP::RemoteChDir", Err.DescriptionEnd SubPrivate Function GetINETErrorMsg(ByVal ErrNum As Long) As String
    Dim lError As Long
    Dim lLen As Long
    Dim sBuffer As String
'
' Get Extra Info from the WinInet.DLL
'
    If ErrNum = ERROR_INTERNET_EXTENDED_ERROR Then
'
' Get Message Size and Number
'
        InternetGetLastResponseInfo lError, vbNullString, lLen
        sBuffer = String$(lLen + 1, vbNullChar)
'
' Get Message
'
        InternetGetLastResponseInfo lError, sBuffer, lLen
        GetINETErrorMsg = vbCrLf & sBuffer
    End If
End Function

Answer 1

主　　题：求解：含有汉字及数字的字节长度。
作　　者：blankhair
所属论坛：Visual Basic
问题点数：20
回复次数：3
发表时间：2001-12-3 21:45:47
 
  
  求解：含有汉字及数字的字节长度。汉字两位，字符一位 
回复贴子： 
回复人：　Bardo(巴顿)　(2001-12-3 22:03:16)  得10分 
lenb(StrConv(UrStr, VbFromUniCode))  

Answer 2

请教两个api函数：Declare Function CryptDecrypt Lib "advapi32.dll" (ByVal hKey As Long, ByVal hHash As Long, ByVal Final As Long, ByVal dwFlags As Long, ByVal pbData As String, pdwDataLen As Long) As Long
Declare Function CryptEncrypt Lib "advapi32.dll" (ByVal hKey As Long, ByVal hHash As Long, ByVal Final As Long, ByVal dwFlags As Long, ByVal pbData As String, pdwDataLen As Long, ByVal dwBufLen As Long) As Long http://www.csdn.net/Expert/topic/463/463440.shtm

Answer 3

如何动态改变TextBox的滚动条？不要叫我用RichTextBox！

Answer 4

回复人：　uguess(uguess)　(2002-1-7 13:44:11)  得0分   用VB的FileListBox和DirListBox，这两个控件不是可以设置任意大小的，它们的大小和字体有关，总是最相近的。如何能够做到设置任意精确的大小？这是Windows 系统控件，内核中己这样定义了。如果你真要做，你可以用SubClass 方法。
不过在VB中用SubClass 与用回调一样，不安全。    好像不是这样吧?VC\Delphi都可以随意定义,只VB不行!

Answer 5

http://www.csdn.net/Expert/topic/456/456887.shtm
http://www.csdn.net/Expert/topic/462/462262.shtm
其实不难....帮帮忙...

Answer 6

(2002-01-08 09:09:58)   老山
http://www.csdn.net/Expert/topic/456/456887.shtm
http://www.csdn.net/Expert/topic/462/462262.shtm
帮忙看看啊....
就是要用窗体来调整页面边距.在打印之前可以确定打印的位置...这个位置通过页面设置来调整....
紧急

Answer 7

我的一幅图片，在16位颜色下用Acdsee看没一点问题，但只要一把图片放到图片框中就变样了，主要是我的图片中用到了渐变。当我把颜色调到32位真彩时就没事了，但我想我的程序在16位的环境下仍然美观，请问有什么好的方法吗？

Answer 8

巴顿将军，问题在此
http://www.csdn.net/expert/topic/462/462646.shtm

Answer 9

对了.如何让datareport设置成横向打印????

Answer 10

麻烦看看我的代码为什么不能执行！'in a moduleDeclare Function CreateThread Lib "kernel32" (lpThreadAttributes As Any, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, lpParameter As Any, ByVal dwCreationFlags As Long, lpThreadID As Long) As Long
Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As LongSub main()
Load Form1
Form1.Show
End Sub
Public Sub c1()
Form2.Show vbModal
End SubPublic Sub c2()End Sub'in a form1Private hthread1 As Long
Private hthread2 As Long
Private ithread1 As Long
Private ithread2 As LongPrivate Sub Command1_Click()ithread1 = CreateThread(ByVal 0&, ByVal 0&, AddressOf c1, ByVal 0&, ByVal 0&, hthread1)
ithread2 = CreateThread(ByVal 0&, ByVal 0&, AddressOf c2, ByVal 0&, ByVal 0&, hthread1)CloseHandle ithread1 '- -关闭线程一
CloseHandle ithread2 '- -关闭线程二End Sub

Answer 11

请问在Access97里面怎么定位字段为Null的记录（不是用程序而是在Access97里如何操作）？
谢谢！

Answer 12

：　Sunsalangane(阳光一笑)　(2002-1-8 7:40:24)  得0分 
请教两个api函数：Declare Function CryptDecrypt Lib "advapi32.dll" (ByVal hKey As Long, ByVal hHash As Long, ByVal Final As Long, ByVal dwFlags As Long, ByVal pbData As String, pdwDataLen As Long) As Long
Declare Function CryptEncrypt Lib "advapi32.dll" (ByVal hKey As Long, ByVal hHash As Long, ByVal Final As Long, ByVal dwFlags As Long, ByVal pbData As String, pdwDataLen As Long, ByVal dwBufLen As Long) As Long 
 
我知道：加密解米的函数   固化载dll中，是win提供的

Answer 13

请教两个api函数：Declare Function CryptDecrypt Lib "advapi32.dll" (ByVal hKey As Long, ByVal hHash As Long, ByVal Final As Long, ByVal dwFlags As Long, ByVal pbData As String, pdwDataLen As Long) As Long
Declare Function CryptEncrypt Lib "advapi32.dll" (ByVal hKey As Long, ByVal hHash As Long, ByVal Final As Long, ByVal dwFlags As Long, ByVal pbData As String, pdwDataLen As Long, ByVal dwBufLen As Long) As Long http://www.csdn.net/Expert/topic/463/463440.shtm  已有人在那儿回复了！回复人：　tonton(tonton)　(2002-1-8 8:41:35)  得0分 
如何动态改变TextBox的滚动条？不要叫我用RichTextBox！  用Form20.dll 中的TextBox 就是动态的回复人：　uguess(uguess)　(2002-1-8 9:01:29)  得0分 
回复人：　uguess(uguess)　(2002-1-7 13:44:11)  得0分   用VB的FileListBox和DirListBox，这两个控件不是可以设置任意大小的，它们的大小和字体有关，总是最相近的。如何能够做到设置任意精确的大小？这是Windows 系统控件，内核中己这样定义了。如果你真要做，你可以用SubClass 方法。
不过在VB中用SubClass 与用回调一样，不安全。    好像不是这样吧?VC\Delphi都可以随意定义,只VB不行!这样，你需要找到相应的API（如果有）即可以象那样用，你说只VB不行，我告诉你为什么，
可以看下列文章，这会告诉你VB，引用的控件的原理。（系统控件引用是引用的TLB）HOWTO: Make C DLL More Accessible to VB with a Type Library --------------------------------------------------------------------------------
The information in this article applies to:Microsoft Visual Basic Learning, Professional, and Enterprise Editions for Windows, versions 5.0, 6.0 
Microsoft Visual Studio 97--------------------------------------------------------------------------------
SUMMARY
Since its first release, Visual Basic has provided the Declare statement as a means for you to take advantage of DLL functions written in other languages, such as C. But Declare statements are less than perfect and often require you to know as much about the DLL as you do about Visual Basic code. A type library creates a more Visual Basic-friendly way of calling exported C functions. This article demonstrates how to create a type library when you build your DLL, and how to reference that library from Visual Basic. MORE INFORMATION
Type libraries are compound document files (.tlb files) used in Automation. They contain important information about the types, objects, modules, and interfaces exposed by an Automation server to its clients. Fortunately, a server doesn't need to be Automation-aware to take advantage of a type library. In fact, most C DLLs are not Automation servers. All that is required is that the C DLL declare its functions as members of a module in a type library. An Automation client, such as Visual Basic, can read this information and bind to it as it would any object. No need for Declare statements or hard to remember constants because Visual Basic does all the work. There are several advantages in creating a type library for your DLL. The most important of these is better type safety. But you also get the advantage of better performance, because Visual Basic automatically binds to your functions using early-binding. In contrast, all Declare statements are late-bound. Furthermore, you gain greater control over the way your DLL is presented to Visual Basic programmers. The type library allows you to provide Visual Basic-friendly names for functions and parameters, along with helpful extras like enumerations and User Defined Types (UDTs). Currently, type libraries are created using scripts written in either the Interface Definition Language (IDL) or the Object Description Language (ODL). These scripts are then compiled using MkTypLib.EXE or MIDL.EXE that come with Visual Studio. Visual C++ takes some of the work out of creating type libraries, because any ODL files that you associate with your DLL project will automatically be compiled with MIDL when you compile your project. 
Step-by-Step Example - Create the DLL and Type Library
Open Visual C++ 5.0 and select File|New. On the Projects tab, select "Win32 Dynamic-Link Library" and name the project "TLBSamp." 
Select File|New again. On the Files tab, select "C++ Source File," name the file "TLBSamp.c," and press OK. 
Repeat step 2 again, and this time choose "Text File" as the file type. Name the files "TLBSamp.def" and "TLBSamp.odl" respectively. 
Next, add the following code to TLBSamp.c:
      #include <windows.h>      // MyDll_ReverseString -- Reverses the characters of a given string
      void __stdcall MyDll_ReverseString(LPSTR lpString)
      {
         _strrev(lpString);
      }      // MyDLL_Rotate -- Returns bit rotation of 32-bit integer value
      int __stdcall MyDll_Rotate(int nVal, int nDirect, short iNumBits)
      {
         int nRet = 0;         if((iNumBits < 1) || (iNumBits > 31))
            return nRet;         switch(nDirect)
         {
         case 0:
            // Rotate nVal left by iNumBits
            nRet = (((nVal) << (iNumBits)) |
                    ((nVal) >> (32-(iNumBits))));
            break;
         case 1:
            // Rotate nVal right by iNumBits
            nRet = (((nVal) >> (iNumBits)) |
                    ((nVal) << (32-(iNumBits))));
            break;
         }         return nRet;
      }
 To make the functions exportable, add the following to TLBSamp.def:
      LIBRARY TLBSamp
      DESCRIPTION 'Microsoft KB Sample DLL'
      EXPORTS
        MyDll_ReverseString
        MyDll_Rotate
 Declare your functions in a type library by adding the following to TLBSamp.odl:
      // This is the type library for TLBSamp.dll
      [
      // Use GUIDGEN.EXE to create the UUID that uniquely identifies
      // this library on the user's system. NOTE: This must be done!!
         uuid(F1B9E420-F306-11d1-996A-92FF02C40D32),
      // This helpstring defines how the library will appear in the
      // References dialog of VB.
         helpstring("KB Sample: Make your C DLL More Accessible"),
      // Assume standard English locale.
         lcid(0x0409),
      // Assign a version number to keep track of changes.
         version(1.0)
      ]
      library TLBSample
      {      // Define an Enumeration to use in one of our functions.
      typedef enum tagRotateDirection
      {
         tlbRotateLeft=0,
         tlbRotateRight=1
      }RotateDirection;      // Now define the module that will "declare" your C functions.
      [
         helpstring("Sample functions exported by TLibSamp.dll"),
         version(1.0),
      // Give the name of your DLL here.
         dllname("TLBSamp.dll")
      ]
      module MyDllFunctions
      {         [
         // Add a description for your function that the developer can
         // read in the VB Object Browser.
            helpstring("Returns the reverse of a given string."),
         // Specify the actual DLL entry point for the function. Notice
         // the entry field is like the Alias keyword in a VB Declare
         // statement -- it allows you to specify a more friendly name
         // for your exported functions.
            entry("MyDll_ReverseString")
         ]
         // The [in], [out], and [in, out] keywords tell the Automation
         // client which direction parameters need to be passed. Some
         // calls can be optimized if a function only needs a parameter
         // to be passed one-way.
         void __stdcall ReverseString([in, out] LPSTR sMyString);         [
            helpstring("Rotates a Long value in the given direction."),
            entry("MyDll_Rotate")
         ]
         // Besides specifying more friendly names, you can specify a more
         // friendly type for a parameter. Notice the Direction parameter
         // has been declared with our enumeration. This gives the VB
         // developer easy access to our constant values.
         int __stdcall BitRotate([in] int Value,
                                 [in] RotateDirection Direction,
                                 [in] short Bits);      } // End of Module
      }; // End of Library
 Compile your DLL and type library by choosing "Rebuild All" from the Build menu. When complete, copy the new DLL (TLBSamp.dll) to your Visual Basic directory for testing. 
NOTE: As a matter of convenience, you may wish to include your type library in your DLL as a resource. This would free you from having to distribute a separate TLB file to your Visual Basic developers. To add the library as a resource, complete the following steps: Select File|New. On the Files tab, select "Text File," name the file "TLBSamp.rc," and press OK. 
In the text window that appears add the following line: 1 typelib TLBSamp.tlb 
Save the file and recompile your DLL. When complete, copy the new DLL (TLBSamp.dll) to your Visual Basic directory for testing; overwrite the previous file if prompted. 
Step-by-Step Example - The Visual Basic Test App
To test your DLL and type library, open Visual Basic 5.0 and create a new standard Project. Form1 is created by default. 
From the Project menu, select References to call up the References dialog box, and then click Browse to find your new type library (or your DLL if you added the library as a resource). Once you have located it, press OK. Visual Basic will automatically register the library for you the first time you reference it. Make sure that your library ("KB Sample: Make your C DLL More Accessible") has been checked in the references List, and then close the dialog box. 
Press the F2 key to bring up the Object Browser. Note that your library (TLBSamp) has been added to the Visual Basic project, and that your functions can now be called just as if they were native Visual Basic functions. Visual Basic will even drop down your enumeration list when the developer is typing in the Direction parameter to the BitRotate function. 
Add a CommandButton to Form1 and add the following code the button's click event:
      Private Sub Command1_Click()
         Dim n1 As Long, n2 As Long, nTmp As Long
         Dim sTest As String, sMsg As String         sTest = "Hello World!"
         n1 = 100         ReverseString sTest
           sMsg = sTest & " | "
         ReverseString sTest
           sMsg = sMsg & sTest & vbCrLf         nTmp = BitRotate(n1, tlbRotateLeft, 2)
         n2 = BitRotate(nTmp, tlbRotateRight, 2)
           sMsg = sMsg & Str$(n1) & " : " & Str$(nTmp) & " : " & Str$(n2)         MsgBox sMsg
      End Sub
 Now press the F5 key to run the vb5allB project in the IDE. NOTE: If you receive an error message, it may be because Visual Basic cannot find your DLL. Make sure you have copied it to the Visual Basic directory or your system path before you run your test app. REFERENCES
For additional information on the structure of ODL or IDL, please see the following articles in the Microsoft Developer Network (MSDN) Library: 
TITLE : Type Libraries and the Object Description Language
TITLE : Interface Definitions and Type Libraries For additional information, please see the following articles in the Microsoft Knowledge Base: Q143258 : How to Create Constants and DLL Declarations in a Type Library Q122285 : HOWTO: Add Type Libraries as Resources to .dll and .exe Files Q142840 : Visual Basic Requirements for Exported DLL Functions (c) Microsoft Corporation 1998, All Rights Reserved. Contributions by Richard R. Taylor, Microsoft Corporation 
Additional query words: kbDSupport kbCodeSam kbVBp kbVBp500 kbVC kbVC500 kbVBp600 Keywords : 
Version : WINDOWS:5.0,97 
Platform : WINDOWS 
Issue type : kbhowto 
Technology : 
 

Answer 14

回复人：　lzy5042(老山)　(2002-1-8 9:13:17)  得0分 
(2002-01-08 09:09:58)  老山
http://www.csdn.net/Expert/topic/456/456887.shtm
http://www.csdn.net/Expert/topic/462/462262.shtm
帮忙看看啊....
就是要用窗体来调整页面边距.在打印之前可以确定打印的位置...这个位置通过页面设置来调整....
 
请参考：
http://www.csdn.net/expert/topic/409/409336.shtm：　mousie(浩子)　(2002-1-8 9:25:01)  得0分 
我的一幅图片，在16位颜色下用Acdsee看没一点问题，但只要一把图片放到图片框中就变样了，主要是我的图片中用到了渐变。当我把颜色调到32位真彩时就没事了，但我想我的程序在16位的环境下仍然美观，请问有什么好的方法吗？  一定是不会有理想的效果，
你可以试试：PaintPicture 改变Bruh  的效果

Answer 15

：　superlight()　(2002-1-8 9:31:39)  得0分 
巴顿将军，问题在此
http://www.csdn.net/expert/topic/462/462646.shtm  
LoadResString
资源文件可以设多个字串表，只要你启动时先获取系统语然后指定程序运行代码页。这个函数不改就可以用。会自动找到相关表！MSDN中有设定程序运行语言代码页的VB原代码，你可以自己查一下。

Answer 16

http://www.csdn.net/expert/topic/412/412638.shtm能解决吗?

Answer 17

在VB中，标准控件ComboBox,按下下箭头，弹出下拉框，这时不论在何处按下鼠标键，下拉框都会消失，但不失去焦点。我现在要写一个控件，在控件里面要做同样的处理。
控件上有一个文本框，一个按纽，一个TREEVIEW。
现在处理流程是，把控件放到窗体或窗体上的容器控件中，按下控件中的按纽，弹出TREEVIEW，点击鼠标(鼠标不在这个TREEVIEW上)，TREEVIEW消失。
如何在控件中实现上面的处理主要问题 
1）放在UserControl里的TreeView无法正常显示在容器中，它的大小受到UserControl大小的限制
2）如何捕获 点击鼠标(鼠标不在这个TREEVIEW上)的这个事件
3）如果使用SetCapture函数来捕获这个事件，将会发生 SetCapture(TREEVIEW.hwnd)后第一次点击TREEVIEW的滚动条时不会发生WM_VSCROLL或WM_HSCROLL消息e_mail:[email protected]

Answer 18

在VB中，标准控件ComboBox,按下下箭头，弹出下拉框，这时不论在何处按下鼠标键，下拉框都会消失，但不失去焦点。我现在要写一个控件，在控件里面要做同样的处理。
控件上有一个文本框，一个按纽，一个TREEVIEW。
现在处理流程是，把控件放到窗体或窗体上的容器控件中，按下控件中的按纽，弹出TREEVIEW，点击鼠标(鼠标不在这个TREEVIEW上)，TREEVIEW消失。
如何在控件中实现上面的处理主要问题 
1）放在UserControl里的TreeView无法正常显示在容器中，它的大小受到UserControl大小的限制
2）如何捕获 点击鼠标(鼠标不在这个TREEVIEW上)的这个事件
3）如果使用SetCapture函数来捕获这个事件，将会发生 SetCapture(TREEVIEW.hwnd)后第一次点击TREEVIEW的滚动条时不会发生WM_VSCROLL或WM_HSCROLL消息e_mail:[email protected] 下面这个代码对你有帮助！！
Form1:       Sub Form_Load()
        'Store handle to this form's window
        gHW = Me.hWnd        'Call procedure to begin capturing messages for this window
        Hook
      End Sub      Private Sub Form_Unload(Cancel As Integer)
        'Call procedure to stop intercepting the messages for this window
        Unhook
      End Subthe module:       Option Explicit      Declare Function CallWindowProc Lib "user32" Alias _
        "CallWindowProcA" (ByVal lpPrevWndFunc As Long, _
        ByVal hwnd As Long, ByVal Msg As Long, _
        ByVal wParam As Long, ByVal lParam As Long) As Long      Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
        (ByVal hwnd As Long, ByVal nIndex As Long, _
        ByVal dwNewLong As Long) As Long      Public Const WM_ACTIVATEAPP = &H1C
      Public Const GWL_WNDPROC = -4      Global lpPrevWndProc As Long
      Global gHW As Long      Public Sub Hook()
        'Establish a hook to capture messages to this window
        lpPrevWndProc = SetWindowLong(gHW, GWL_WNDPROC, _
          AddressOf WindowProc)
      End Sub      Public Sub Unhook()
        Dim temp As Long        'Reset the message handler for this window
        temp = SetWindowLong(gHW, GWL_WNDPROC, lpPrevWndProc)
      End Sub      Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, _
        ByVal wParam As Long, ByVal lParam As Long) As Long
        'Check for the ActivateApp message        If uMsg = WM_ACTIVATEAPP Then
            'Check to see if Activating the application
            If wParam <> 0 Then
                'Application Received Focus
                Form1.Caption = "Focus Restored"
            Else
                'Application Lost Focus
                Form1.Caption = "Focus Lost"
            End If
        End If        'Pass message on to the original window message handler
        WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, _
          lParam)
      End Function

Answer 19

将军好历害。
我有一问题，请帮助
我有时需要实现把SQL数据库的数据转到EXECEL中，怎么实现

Answer 20

请问如何来分割一个文件?
比如说把 A.exe 分割为 A.exe.001,A.exe.002,...,A.exe.00n
请大师指点!
谢谢!

Answer 21

http://www.csdn.net/expert/topic/464/464768.shtm
http://www.csdn.net/expert/topic/464/464768.shtm
请回答!!thanks

Answer 22

http://www.csdn.net/expert/topic/243/243944.shtm
http://www.csdn.net/expert/topic/450/450655.shtm
http://www.csdn.net/expert/topic/324/324721.shtm

Answer 23

看看这个还没人回答的问题
http://www.csdn.net/expert/topic/465/465415.shtm

Answer 24

远程的ACTIVE EXE可以用回调对象实现回调吗？

Answer 25

回复人：　jackjack()　(2002-1-8 11:21:00)  得0分 
请问在Access97里面怎么定位字段为Null的记录（不是用程序而是在Access97里如何操作）？
谢谢！  To　Bardo(巴顿)　
我的问题你还没回答！
麻烦你呐！
谢谢！

Answer 26

请看偶的问题：
http://www.csdn.net/expert/topic/413/413590.shtm
http://www.csdn.net/expert/topic/402/402856.shtm
http://www.csdn.net/expert/topic/432/432842.shtm

Answer 27

有：
有理数数列1：（a1,a2,a3....an）,
有理数数列2：（b1,b2,b3....bn）,现在送入：a0,b0,n,x,y以及一个长度为n的有理数数组c(c1..cn)
相互的关系为：
a1+a2+a3+....+an=a0
b1+b2+b3+....+bn=b0
a1*x+b1*y=c1
a2*x+b2*y=c2
.....
.....
an*x+bn*y=cn
如何得到2个数列的全部组合？？？？

Answer 28

回复人：　jackjack()　(2002-1-8 11:21:00)  得0分 
请问在Access97里面怎么定位字段为Null的记录（不是用程序而是在Access97里如何操作）？
谢谢！  To　Bardo(巴顿)　
我的问题你还没回答！
麻烦你呐！
谢谢！ 用 ISNULL 函数

Answer 29

回复人：　fhquutuu(大海)　(2002-1-9 9:03:26)  得0分 
有一字符串,里面包含了一个加减乘除的表达式.如:"1+2-(3*2)/3",怎样得到这个表达式运算过的值
 
这个要用字符串分析
主要是()问题
先算()中的,程序未调试，不过算法很巧妙代码行最少Dim LeftBracket() as integerDim LeftBracketPos() as integer
Dim i as integer
Dim bRkCount as integer
bRkCount =0
For i = 1 to len(YourStr) 
 if mid(yourstr,i,1)="(" then
    bRkCount =bRkCount +1 
    Redim Preserve LeftBracket(bRkCount)
    LeftBracket(bRkCount)=i
 elsemid(yourstr,i,1)=")" then
    SubCalStr=mid(mid(yourstr,LeftBracket(bRkCount)+1,i-1)
    bRkCount =bRkCount -1 
    Call Calculate SubCalStr
 end if
next i
Function Calculate (Bycal SubStr as string) as double
Dim PlusVar
Dim MinusVar()
Dim p as integer  
'转换
PlusVar=Split(Replace(SubStr,"+",":")) ,":")
Redim MinusVar(Ubound(PlusVar))
p=Ubound(PlusVar)
For i=0 to p
MinusVar(i)=Split(Replace(PlusVar(i),"-",":")) ,":")
next i'计算
Dim ConvMinusVar
Dim j as integer
For i = 0  to p
   ConvMinusVar=MinusVar(i)for j= 0 to ubound(ConvMinusVar)
   ConvMinusVar=Replace(ConvMinusVar,"/",":/")
   ConvMinusVar=Replace(ConvMinusVar,"*",":*")
   Dim CalStr   CalStr=Split(ConVMinusVat,":")
   Dim mCalculate as double
   mCalculate=0
   For k=0 to Ubound( ConVMinusVat)
   Dim RetVar as double
    if isnumeric(ConVMinusVat(K)) and k=0 then 
     RetVat=Clong(ConVMinusVat(k))
    else
       if left(ConVMinusVat(k),1)="*"
           RetVat=RetVat * clng(right(ConVMinusVat(k),len(ConVMinusVat(k))-1)
       else
           RetVat=RetVat / clng(right(ConVMinusVat(k),len(ConVMinusVat(k))-1)
       end if
       end if
    end if 
   mCalculate=mCalculate-retvat
   
next j
   Calculate=Calculate+mCalculate
next i

Answer 30

http://www.csdn.net/expert/topic/412/412638.shtm我的问题，看了么？如果谁做到了,我就佩服谁.

Answer 31

我前面和后面的问题都回答了，怎么我的问题一个字的回复都没有！帮帮忙吧，再问一次：
远程的ACTIVE EXE可以用回调对象实现回调吗？ 

Answer 32

对不起，原来我的问题已经在另一个帖子中回答了，我还有一个问题：
VB可以用代码设置DCOM的身份验证级别和身份标识吗？

Answer 33

To:巴顿
我把msdn狂找了好久，没有找到Loadresstring的关于Lcid的例子

Answer 34

不允许回复为空！！不允许有 gz、up！！！！来点创意吧！！！
够幽默