回 帖 发 新 帖 刷新版面

主题:请教VB代码转换成VFP代码?


Public Function GetProgID(ByVal sFileName As String) As Variant
    Dim TLibInfo As TypeLibInfo
    Dim TLibClass As CoClasses
    Dim sResult() As String
    Dim sHeader As String
    Dim i As Integer   
    On Error GoTo ErrorMark   
    'Initialize
    GetProgID = ""
    sHeader = ""
    Set TLibInfo = TypeLibInfoFromFile(Trim(sFileName))
    Set TLibClass = TLibInfo.CoClasses

    'ProgID Header
    sHeader = TLibInfo.Name
   
    If TLibClass.Count > 0 Then
        ReDim sResult(TLibClass.Count - 1)
       
        For i = 1 To TLibClass.Count
            sResult(i - 1) = sHeader + "." + TLibClass.Item(i).Name
        Next i
       
        GetProgID = sResult
    End If
   
ErrorMark:
    Set TLibInfo = Nothing
    Set TLibClass = Nothing
End Function

Public Function CheckFormat(ByVal sFileName As String) As Boolean
    Dim TLibInfo As TypeLibInfo
    Dim TLibClass As CoClasses
   
    On Error GoTo ErrorMark
   
    CheckFormat = False
    Set TLibInfo = TypeLibInfoFromFile(Trim(sFileName))
    Set TLibClass = TLibInfo.CoClasses
   
    If Trim(TLibInfo.Name) <> "" And TLibClass.Count > 0 Then
        CheckFormat = True
    End If
           
ErrorMark:
    Set TLibInfo = Nothing
    Set TLibClass = Nothing
End Function
请即懂VFP又懂VB的老师帮助一下,把以上代码转换成VFP代码行不?

回复列表 (共12个回复)

沙发

以上代码,vfp 没有办法使用。

在 VFP 要使用同样功能,
必须调用一个 tli 对象,

其功能:获得一个已注册,类库文件信息。


板凳

[quote]
在 VFP 要使用同样功能,
必须调用一个 tli 对象,
其功能:获得一个已注册,类库文件信息。
[/quote]
  cbl518老师,你好,真是太感谢你了,我的帖子基本上都你第一个回我!这是我在网上论坛中找到一个别人的回答,目的是从DLL文件中直接读取ProgID值的自定义函数,我想把它转变成VFP代码,但你提到的“tli对象”是一个什么控件不清楚,是VB中的还是WIN系统中VF也可以调用的,或者说在VFP中想达到此功能有没有像此函数一样的较简单的方式。

3 楼

Function GetProgID(sFileName)
local TLibInfo,TLibClass,sResult,sHeader,iii
On Error store .null. to TLibInfo,TLibClass
    'Initialize
    GetProgID = ""
    sHeader = ""
    TLibInfo = TypeLibInfoFromFile(Trim(sFileName))
    TLibClass = TLibInfo.CoClasses

    'ProgID Header
    sHeader = TLibInfo.Name
   
    If TLibClass.Count > 0 Then
        Dimension sResult(TLibClass.Count - 1)
       
        For i = 1 To TLibClass.Count
            sResult(i - 1) = sHeader + "." + TLibClass.Item(i).Name
        Next
       
        Return @sResult
    EndIf
EndFunction

Function CheckFormat(sFileName)
local TLibInfo,TLibClass   
    On Error store .null. to TLibInfo,TLibClass
   
    TLibInfo = TypeLibInfoFromFile(Trim(sFileName))
    TLibClass = TLibInfo.CoClasses
   
    If Trim(TLibInfo.Name) <> "" And TLibClass.Count > 0 Then
        Return .T.
    Else
        Return .F.
    EndIf
EndFunction

4 楼

终于解决了,发出来供网友一同分享!在此多谢cbl518老师提醒,我在网上搜索了很久
才找到"TLI.TLIApplication",一直不知道这个字符串是怎么样写的.

**************************************************************************
***********自定义函数GetProgID(DLL或OCX文件名[,是否返回所有])************
********从DLL、OCX文件直接取出其包含的ActiveX控件的引用名即:ProgID*******
**************************************************************************
**参数1是DLL或OCX文件名,参数2是判断是否返回所有引用名(为真时返回所有)**
FUNCTION GetProgID(cFileName as String,ltype as Logical)
LOCAL oTLI,oTLIType,cCoClasses
LOCAL cHeader,cErrorStr,cReturnProgID,I
IF TYPE("cFileName")#"C"
    MESSAGEBOX("参数1错误!",64,"GetProgID函数")
    RETURN ""
ENDIF
IF TYPE("ltype")#"L"
    ltype=.F.
ENDIF
IF !FILE(cFileName,1)
    MESSAGEBOX("文件["+cFileName+"]不存在!",16,"GetProgID函数")
    RETURN ""
ENDIF
cErrorStr=ON("ERROR")
ON ERROR cReturnProgID=""
oTLI=CREATEOBJECT("TLI.TLIApplication")
ON ERROR &cErrorStr
IF TYPE("oTLI")#"O"
    MESSAGEBOX("建立TLI对象失败!",64,"GetProgID函数")
    RETURN ""
ENDIF
ON ERROR cReturnProgID=""
oTLIType=oTLI.TypeLibInfoFromFile(cFileName)
ON ERROR &cErrorStr
IF TYPE("oTLIType")#"O"
    MESSAGEBOX("TLI建立文件失败!",64,"GetProgID函数")
    RETURN ""
ENDIF
cHeader=oTLIType.Name
IF oTLIType.CoClasses.Count>0
    DIMENSION aCoClasses[oTLIType.CoClasses.Count]
    aCoClasses=""
    cCoClasses=""
    FOR I=1 TO oTLIType.CoClasses.Count
        aCoClasses[I]=cHeader+"."+oTLIType.CoClasses.Item(I).Name
        cCoClasses=cCoClasses+IIF(I=1,"",",")+aCoClasses[I]
    ENDFOR
    IF ltype=.T.       
        cReturnProgID=cCoClasses
    ELSE
        cReturnProgID=aCoClasses&&
    ENDIF
ELSE
    MESSAGEBOX("文件没有引用对象!",64,"GetProgID函数")
    cReturnProgID=""
ENDIF
RELEASE oTLI,oTLIType
RETURN cReturnProgID

5 楼

CLEAR
DIMENSION aCoClasses[1]
aCoClasses= GetProgID("Richtx32.ocx",.F.)
?


*********************************
FUNCTION GetProgID(cFileName as String,ltype as Logical)
LOCAL oTLI,oTLIType,cCoClasses
LOCAL cHeader,cErrorStr,I

ltype=IIF(TYPE("ltype")#"L",.F.,ltype)
cErrorStr=ON("ERROR")
ON ERROR i=.T.
oTLI=CREATEOBJECT("TLI.TLIApplication")
IF TYPE("oTLI")#"O"
    MESSAGEBOX("建立TLI对象失败!",64,"GetProgID函数")
    RETURN ""
ENDIF
oTLIType=oTLI.TypeLibInfoFromFile(cFileName)
ON ERROR &cErrorStr
IF TYPE("oTLIType")#"O"
    MESSAGEBOX("TLI建立文件失败!",64,"GetProgID函数")
    RETURN ""
ENDIF
cHeader=oTLIType.Name
IF oTLIType.CoClasses.Count>0
    i=IIF(ltype,oTLIType.CoClasses.Count,1)
    DIMENSION aCoClasses[i]
    FOR I=1 TO i
        aCoClasses[I]=cHeader+"."+oTLIType.CoClasses.Item(I).Name
    ENDFOR
ELSE
    MESSAGEBOX("文件没有引用对象!",64,"GetProgID函数")
    aCoClasses=""
ENDIF
RELEASE oTLI,oTLIType
RETURN @aCoClasses

6 楼

[quote]CLEAR
DIMENSION aCoClasses[1]
aCoClasses= GetProgID("Richtx32.ocx",.F.)
?


*********************************
FUNCTION GetProgID(cFileName as String,ltype as Logical)
LOCAL oTLI,oTLIType,cCoClasses
LOCAL cHeader,cErrorStr,I

ltype=IIF(TYPE("ltype")#"L",.F.,ltype)
cErrorStr=ON("ERROR")
ON ERROR i=.T.
oTLI=CREATEOBJECT("TLI.TLIApplication")
IF TYPE("oTLI")#"O"
    MESSAGEBOX("建立TLI对象失败!",64,"GetProgID函数")    
    [color=FF0000]RETURN ""[/color]
ENDIF
oTLIType=oTLI.TypeLibInfoFromFile(cFileName)
ON ERROR &cErrorStr
IF TYPE("oTLIType")#"O"
    MESSAGEBOX("TLI建立文件失败!",64,"GetProgID函数")
    RETURN ""
ENDIF
cHeader=oTLIType.Name
IF oTLIType.CoClasses.Count>0
    i=IIF(ltype,oTLIType.CoClasses.Count,1)
    DIMENSION aCoClasses[i]
    FOR I=1 TO i
        aCoClasses[I]=cHeader+"."+oTLIType.CoClasses.Item(I).Name
    ENDFOR
ELSE
    MESSAGEBOX("文件没有引用对象!",64,"GetProgID函数")
    aCoClasses=""
ENDIF
RELEASE oTLI,oTLIType
RETURN @aCoClasses[/quote]
红色字位置是不是没有恢复ON ERROR &cErrorStr???

7 楼

RETURN @aCoClasses 好像不行,提示数组aCoClasses,我看了一下帮助说要PUBLIC才行,LOCAL 和 PRIVATE 数组在这些声明中无效。
VFP9帮助中给出了以下示例代码:
DEFINE CLASS t1 AS custom OLEPUBLIC
   DIMENSION Arrayelement[3]
   FUNCTION GetMyArray() AS array
      this.Arrayelement[1] = 1
      this.Arrayelement[2] = 2 
      this.Arrayelement[3] = 3
      RETURN @THIS.Arrayelement &&这也有效,因为是全局可访问的.
   ENDFUNC
ENDDEFINE

8 楼

PRIVATE aCoClasses  && 或者不声明 都没问题啊
DIMENSION aCoClasses[1]
aCoClasses= GetProgID("Richtx32.ocx",.F.)

9 楼

红色字位置是不是没有恢复ON ERROR &cErrorStr???

对!

10 楼

我的意思是在RETURN @aCoClasses 中的数组系统不认LOCAL 和 PRIVATE 数组,而是要全局性的数组,所以上面的RETURN @THIS.Arrayelement才有效,而它RETURN @aCoClasses提示aCoClasses不是数组.

我来回复

您尚未登录,请登录后再回复。点此登录或注册