Dll 返回String 出错

Question

以下代码是两个函数，返回的date型没问题， 但是返回String 型的时候会变成乱码，调用不了。
大侠帮忙看看Function DLLMain(ByVal A As Long, ByVal B As Long, ByVal c As Long) As Long
    DLLMain = 1
End FunctionSub Main()
    'This is a dummy, so the IDE doesn't complain
    'there is no Sub Main.
'    Dim test As String
'    test = getdate
Dim test As Date
test = gettime
MsgBox test
End Sub'add more functions here, ie.
'Function addition(ByVal A As Double, ByVal B As Double) As Double
'    addition = A + B
'End Function
Function gettime() As DateDim cn As New ADODB.Connection
Dim cmd As New ADODB.Command
Dim rst As New ADODB.RecordsetOn Error GoTo ErrProcn.ConnectionString = "driver={SQL Server};" & _
"server=cnaecfuyd000072;uid=sa;pwd=123623255;database=master"
cn.ConnectionTimeout = 300
cn.Opencmd.ActiveConnection = cn
cmd.CommandText = "Select getdate() as sys_Time"
'cmd.ActiveConnection = cn
Set rst = cmd.Execute
gettime = Format(rst(0), "yyyy-MM-dd HH:mm:ss")
rst.Close
cn.Close
Exit FunctionErrPro:
gettime = Format(Now(), "YYYY-mm-DD HH:mm:ss")End FunctionFunction getdate() As StringDim cn As New ADODB.Connection
Dim cmd As New ADODB.Command
Dim rst As New ADODB.RecordsetOn Error GoTo ErrProcn.ConnectionString = "driver={SQL Server};" & _
"server=cnaecfuyd000072;uid=sa;pwd=123623255;database=master"
cn.ConnectionTimeout = 300
cn.Open
cmd.ActiveConnection = cn
cmd.CommandText = "select convert(char(20),getdate(),120) as sys_date"
'cmd.ActiveConnection = cn
Set rst = cmd.Execute
getdate = rst(0)
rst.Close
cn.Close
Exit FunctionErrPro:
getdate = Format(Now(), "YYYY-mm-DD HH:mm:ss")End Function

Answer 1

cmd.CommandText = "select getdate() as sys_date" Set rst = cmd.Execute 
getdate = str(rst(0)) 

Answer 2

Function getdate() As String 中：getdate = rst(0) -> getdate = Format(rst(0), "YYYY-MM-DD HH:nn:ss")

Answer 3

是这样的。DateTime 型保存在内存中时是 Double 数值。当你把字符串变量赋值给一个日期型变量时，VB 会自动进行类型转换。但是，当你把一个 Double 型数传给 String 型变量时，系统并不知道应当转换成日期字符串。除非你Dim myDate As Date......
myDate = rst(0)
getdate = myDate中转一下。不过，日期型直接赋值给字符串，日期的格式是由本机地区设置决定的。不如直接格式化成字符串，赋给字符串变量。

Answer 4

不行哦，我用你的方法发布DLL 的时候说“ File already exists”

Answer 5

如果你这是VB6的DLL进行改造编译的,则这个帖子能帮到你,同样的问题:http://www.m5home.com/bbs/dispbbs.asp?boardid=34&Id=1690

Answer 6

能不能帮我修改以下上面代码，我看了那个帖子，尝试跟着改好像不能实现，一调试就出错，VB 都关闭了。
这是代码：
Option Explicit
'È¡Îı¾Ö¸ÕëµØÖ·
Private Declare Function SetHandleCount Lib "Kernel32" _
        (ByVal a As String) As Long
'Ö¸Õëµ½Îı¾
Private Declare Function SetHandleCount1 Lib "Kernel32" _
        Alias "SetHandleCount" (ByVal a As Long) As String
'дµ½ÄÚ´æ
Private Declare Function RtlMoveMemory Lib "Kernel32" _
        (ByVal a As Long, ByVal b As String, ByVal c As Long) As Long
''''''''''''''''''''''''''''''''''''''''''''''''
''    DLL PROJECT ©2004 DanSoft Australia     ''
''   Your dlls MUST HAVE a DLLMain and Main   ''
'' proc, otherwise it won't compile properly! ''
''''''''''''''''''''''''''''''''''''''''''''''''Function DLLMain(ByVal a As Long, ByVal b As Long, ByVal c As Long) As Long
    DLLMain = 1
End FunctionSub Main()
    'This is a dummy, so the IDE doesn't complain
    'there is no Sub Main.
End SubFunction gettime()
Dim cn As New ADODB.Connection
Dim cmd As New ADODB.Command
Dim rst As New ADODB.Recordset
Dim str As StringOn Error GoTo ErrProcn.ConnectionString = "driver={SQL Server};" & _
"server=cnaecfuyd000072;uid=sa;pwd=123623255;database=master"
cn.ConnectionTimeout = 300
cn.Open
cmd.ActiveConnection = cn
cmd.CommandText = "select convert(char(20),getdate(),120) as sys_date"
'cmd.ActiveConnection = cn
Set rst = cmd.Execute
str = CStr(rst(0))
gettime = str
Call RtlMoveMemory(200, gettime, Len(gettime) * 2 + 1)rst.Close
cn.Close
Exit FunctionErrPro:
gettime = Format(Now(), "YYYY-mm-DD HH:mm:ss")
End Function

Answer 7

DLL中增加一个函数:
Private Function LenPtr(ByVal lpStr As Long) As Long
    '根据指针取BSTR长度
    Dim InStrLen As Long, OutStrArr() As Byte
    
    If lpStr = 0 Then Exit Function
    Call CopyMemory(byval VarPtr(InStrLen),byval (lpStr - 4), 4) '得到输入字符串的长度
    LenPtr = InStrLen
End Function然后:Function gettime()
改为:
Function gettime(byval lpStr as long) as long后面的:
str = CStr(rst(0)) 
gettime = str 
Call RtlMoveMemory(200, gettime, Len(gettime) * 2 + 1) rst.Close 
cn.Close 
Exit Function ErrPro: 
gettime = Format(Now(), "YYYY-mm-DD HH:mm:ss") 
End Function改为:str = CStr(rst(0)) 
gettime = lenb(str)if gettime>LenPtr(lpStr) then      '判断缓冲区长度是否足够,以免出错
    Call copymemory(byval lpStr, byval strptr(str), gettime) 
end ifrst.Close 
cn.Close 
Exit Function ErrPro: 
str= Format(Now(), "YYYY-mm-DD HH:mm:ss") 
gettime = lenb(str)
if gettime>LenPtr(lpStr) then      '判断缓冲区长度是否足够,以免出错
    Call copymemory(byval lpStr, byval strptr(str), gettime)
end if
End Function调用此函数时的声明:Private Declare function gettime Lib "xxxxxx.dll" ( _ 
 ByVal lpStr As Long) as long
调用方法:dim sRet as string,lRet as longsret=string(512,chr(32))  '先分配缓冲区,用空格填充方便清理
lret=gettime(strptr(sret))
msgbox trim(sret)试一下吧.

Answer 8

Of123说的应该是对的，至于发布的时候提示File Already Exists可能是因为发布出来的那个Dll文件已经被某个程序运行了导致不能被覆盖，估计你在“工程-〉属性-〉部件”里面把版本兼容改成二进制兼容就好了，实在不行就重起一下，重起完了以后先用regsvr32 /u 把那个Dll给卸了，再重新发布。好久没搞Dll了记不太清了你试下没小马说的这么复杂吧，你要按他的走，十有八九得给你带沟里

Answer 9

哈哈.看他这种用法,应该是改造DLL为有函数输出的DLL,所以要返回字符串就得用这招....

Answer 10

1899-01-01 00:00:00应该是没取到值，比如：
Dim xx As Date
Debug.Print Format(xx, "yyyy-MM-dd HH:mm:ss")
这两行代码返回的就可能是1899-01-01 00:00:00，当然也可能是别的，这和Windows的区域设置有关。不就一个返回数据库服务器时间嘛，我给你写了一个你参考一下吧：Option ExplicitPublic Function getDate() As String
On Error GoTo ErrPro
    Dim conn As New ADODB.connection
    conn.Open "provider=msdasql;driver={SQL Server};server=.;uid=sa;pwd=;database=master"    Dim rs As New ADODB.Recordset
    rs.Open "select getDate()", conn, 1, 1
    getDate = Format(rs.Fields(0), "yyyy-MM-dd HH:mm:ss")
    rs.Close
    Set rs = Nothing
    conn.Close
    Set conn = Nothing
    Exit Function
ErrPro:
    getDate = Format(Now(), "yyyy-MM-dd HH:mm:ss")
End Function

Answer 11

如果是标准的DLL可能存在小马说的问题，如果只是ActiveX dll的话应该没这回事

Answer 12

没办法呀.........谁叫你非用改造DLL不可呢,,,,,呵呵.其实在实际工程里,该引用就引用,尽量使用成熟的已完全掌握与熟悉的技术来完成.而且话又又又又说回来..........即使是ActiveX DLL,仍然可以想办法动态调用啊.....