VFP封装结构类型示例 - VFP论坛

第 21 楼

得分:0

回复 39楼 csyx

可以试试用打开文件名对话框那个api只显示文件夹做打开文件夹对话框

第 22 楼

得分:0

以下是引用csyx在2022-3-17 22:51:31的发言：
图片缩小点，以免喧宾夺主

不要夺掉主的眼神就好了，难为我这老眼要去找个放大镜。
选取文件夹对话框与选取文件名对话框的样子一样不是不可以，就是有点难为VFP。
通过 GetOpenFileName 的 OPENFILENAME 结构体成员 lpfnHook，在 lpfnHook 的回调函数拦截处理相关消息就可以。
“回调函数”使用的是“函数指针”，VFP没有提供这类型的函数。
VFP不是不可以做，只是真没必要，有这精力不如花点点时间学点C就轻松搞定。

第 23 楼

得分:0

以下是引用cssnet在2022-3-16 10:53:44的发言：

其实当时我说的指针，指的是回调函数指针。
一般若遇太过复杂的Windows API调用，在VFP中我会选择直接放弃。
倘若有可能，则会在VC写的DLL中新增一个函数，用C处理好，然后返回结果让VFP程序直接使用。
如此一来，就不必非要勉强VFP去处理它本就不擅长的、或处理起来相当困难、相当笨拙的、涉及到Windows系统核心部分的API调用。
当然，这就要求VFPer应当具备最起码的VC编程基础。
不过，既然已经要用到比较复杂的Api了，那么掌握C应当也算是最起码的程序员基本功罢？

有时有些事情不好分得清高低，曾经有个人去看医生，问医生他身高算不算正常，医生说：脚能着地就正常。
也试试VFP的“回调函数指针”问题

只贴主要代码，打包下载

GetDir_demo.rar (13.73 KB)

程序代码：

**     
**    StructCalss_DirDialog.prg 
**     
#INCLUDE StructCalss.h
SET PROCEDURE TO StructCalss.prg ADDITIVE
LoadApi() 

? myGetDir("c:\temp\test")


SET PROCEDURE TO
CLEAR ALL
RETURN

FUNCTION myGetDir(cDefDir)
    LOCAL bi, fa, pDir, pDefDir, cDir, pci, pit
    pDir    = apiMalloc(MAX_PATH)
    pDefDir = myStrptr(cDefDir)
    
    fa = CREATEOBJECT("FUNCTIONADDRESS")
    
    bi = CREATEOBJECT("BROWSEINFOA")
    bi.setValue("pszDisplayName", pDir)
    bi.setValue("lpfn",           fa.GetFunAddr("CallbackProc",4))
    bi.setValue("lParam",         pDefDir)
    
    pit = apiSHBrowseForFolder(bi.pBuffer)
    
    cDir = ""
    IF pit > 0
        apiSHGetPathFromIDList(pit, pDir)
        cDir = SYS(2600, pDir, apiStrlen(pDir))
        apiCoTaskMemFree(pit)
    ENDIF
    apiFree(pDefDir)
    apiFree(pDir)
    RETURN cDir
ENDFUNC

** 回调函数
FUNCTION CallbackProc(hWnd, Msg, wParam, lParam)
    IF Msg == BFFM_INITIALIZED
        * BFFM_SETSELECTIONA 消息自动选择初始路径
        apiSendMessage(hWnd, BFFM_SETSELECTIONA, BFFM_INITIALIZED, lParam)
    ENDIF
    RETURN 0
ENDFUNC

    * 获取调用VFP函数的函数指针
DEFINE CLASS FUNCTIONADDRESS as Session
    DIMENSION aPFunction[1]
    hUser32 = 0
    fMessageBox = 0
    pMsg = 0
    pTitle = 0
    hMSvcrt = 0
    fSwprintf = 0
    hOleaut32  = 0
    fSysAllocString = 0
    fSysFreeString  = 0
    pFunName = 0

    PROCEDURE Init
        this.hUser32     = apiLoadLibrary("user32.dll")
        this.fMessageBox = apiGetProcAddress(this.hUser32, "MessageBoxA")
        this.pMsg        = myStrptr("调用 FUNCTIONADDRESS 类 GetFunAddr() 失败")
        this.pTitle      = myStrptr("提示")
        
        this.hMSvcrt   = apiLoadLibrary("msvcrt.dll")
        this.fSwprintf = apiGetProcAddress(this.hMSvcrt, "swprintf")

        this.hOleaut32       = apiLoadLibrary("oleaut32.dll")
        this.fSysAllocString = apiGetProcAddress(this.hOleaut32, "SysAllocString")
        this.fSysFreeString  = apiGetProcAddress(this.hOleaut32, "SysFreeString")
    ENDPROC
    
    PROCEDURE Destroy
        LOCAL pf
        FOR EACH pf IN this.aPFunction
            apiFree(pf)
        ENDFOR
        apiFree(this.pMsg)
        apiFree(this.pTitle)
        apiFree(this.pFunName)
        apiFreeLibrary(this.hUser32)
        apiFreeLibrary(this.hMSvcrt)
        apiFreeLibrary(this.hOleaut32)
    ENDPROC

    FUNCTION GetFunAddr(cFunName, nParameters)    && 函数名，参数个数
        LOCAL nCount, cCode, cMsgCode
        
        IF EMPTY(cFunName)
            RETURN 0
        ENDIF
        
        * 格式：函数名(%d,%d,......%d,%d)
        cFunName = STRCONV(cFunName + "(%d" + REPLICATE(",%d", nParameters - 1) + ")"+0h00, 5)
        this.pFunName = myStrptr(cFunName)
            
        * 出错提示
        cMsgCode = ""
        cMsgCode = cMsgCode + 0h6A00                                && push 0      MessageBox()第4个参数
        cMsgCode = cMsgCode + 0h68 + BINTOC(this.pTitle,"4RS")      && push pTitle MessageBox()第3个参数
        cMsgCode = cMsgCode + 0h68 + BINTOC(this.pMsg,  "4RS")      && push pMsg   MessageBox()第2个参数
        cMsgCode = cMsgCode + 0h6A00                                && push 0      MessageBox()第1个参数
        cMsgCode = cMsgCode + 0hB8 + BINTOC(this.fMessageBox,"4RS") && move eax, fMessageBox
        cMsgCode = cMsgCode + 0hFFD0                                && call MessageBox
        cMsgCode = cMsgCode + 0hB801000000                          && mov  eax,00000001h   返回1（.T.）
            
        *
        * 函数的二进制代码
        *
        * 保存栈顶指针 ebp <- esp, 调整栈顶指针esp <- (esp-2000)预留足够栈空间
        cCode =         0h55                            && PUSH  EBP               保存ebp
        cCode = cCode + 0h8BEC                          && MOV   EBP,ESP          栈顶指针保存到ebp作为栈基址
        cCode = cCode + 0h81EC + BINTOC(2000, "4RS")    && SUB   ESP,000007D0h    预留2000字节足够栈空间

        * swprintf(pOut, "<VFP函数名>(%d,%d,...,%d,%d)", ect1, ect2,..., ectn-1, ectn)
        * 调用swprintf(pOut, pFmt, ect)，将输出参数 pOut 的内容作为VFP函数表达式
        * pOut，输出，指向VFP函数表达式的指针，    表达式: "<VFP函数名>(<数值1>,<数值2>,...,<数值n>)"
        * pFmt，输入，指向VFP函数格式字符串的指针, 表达式: "<VFP函数名>(%d,%d,...,%d)"
        * ect， 输入，参数表，<数值1>,<数值2>,...,<数值n>
        *
        * 函数的输入参数作为swprintf()的ect参数，输出转换为VFP函数的输入参数
    
        * 参数入栈代码
        FOR i = nParameters TO 1 STEP -1
            cCode = cCode;
                  + 0h8B45 + CHR(4 + i * 4);
                  + 0h50
        ENDFOR
        *                                                                               ectn
        * ......                                                                        ectn-1
        *
        * 0h8B450C                                    && MOV   EAX, DWORD PTR [EBP+0C]  ect2
        * 0h50                                        && PUSH  EAX
        * 0h8B4508                                    && MOV   EAX, DWORD PTR [EBP+08]  ect1
        * 0h50                                        && PUSH  EAX
                        
        cCode = cCode + 0hB8 + BINTOC(this.pFunName, "4RS")  && MOV   EAX, pVFP函数    pFmt
        cCode = cCode + 0h50                                  && PUSH  EAX
        cCode = cCode + 0h8D45A0                              && LEA   EAX, [EBP-60h]   pOut
        cCode = cCode + 0h50                                  && PUSH  EAX
        cCode = cCode + 0hB8 + BINTOC(this.fSwprintf, "4RS")  && MOV   EAX, fSwprintf
        cCode = cCode + 0hFFD0                                && CALL  EAX              调用swprintf()
    
        * 因 swfprintf() 不会自动恢复堆栈指针
        * esp 恢复到调用swfprintf()前状态，esp <- esp + (n参数个数+2)*4)
        cCode = cCode + 0h83C4 + CHR((nParameters + 2) * 4)   && ADD   ESP,(n参数个数+2)*4)
    
        * [EBP-10h] = SysAllocString([EBP-60h])
        * 调用SysAllocString()将VFP函数表达式字符串转换成BSTR字符串
        cCode = cCode + 0h8D45A0                                    && LEA   EAX,[EBP-60h]            指向VFP函数表达式字符串指针
        cCode = cCode + 0h50                                        && PUSH  EAX                      作为SysAllocString()输入参数
        cCode = cCode + 0hB8 + BINTOC(this.fSysAllocString, "4RS")  && MOV   EAX, fSysAllocString
        cCode = cCode + 0hFFD0                                      && CALL  EAX                      调用SysAllocString() 

        * 保存SysAllocString()返回的BSTR字符串指针，之后由SysFreeString()释放
        cCode = cCode + 0h8945F0                                    && MOV   [EBP-10h],EAX

        * _VFP.DoCmd(<VFP函数表达式>)
        * 转换成BSTR字符串的VFP函数表达式, 作为调用_VFP对象DoCmd方法的输入参数
        cCode = cCode + 0h50                                        && PUSH  EAX
        cCode = cCode + 0hB8 + BINTOC(SYS(3095, _VFP), "4RS")       && MOV   EAX, SYS(3095, _VFP)     获取_VFP对象的IDispatch指针
        cCode = cCode + 0h50                                        && PUSH  EAX                      _VFP指针
            
        cCode = cCode + 0h8B00                                      && MOV   EAX,[EAX]                获取_VFP的函数表指针
        cCode = cCode + 0h0584000000                                && ADD   EAX,00000084h            _函数表指针偏移 84h 是_VFP.DoCmd函数的指针
        cCode = cCode + 0hFF10                                      && CALL  [EAX]                    调用_VFP.DoCmd(<VFP函数表达式>)
        **cCode = cCode + 0hB800000000                              && MOV   EAX,00000000h            eax <- 0 （DoCmd()返回NULL）
            
        * 是否成功返回0
        cCode = cCode + 0h83F800                                    && CMP  EAX, 0
        * 是，成功返回，跳过出错提示。
        cCode = cCode + 0h74 + CHR(LEN(cMsgCode))                  && je len(cMsgCode)， je=0h74（等于）, jne=0h75（不等于）
        cCode = cCode + cMsgCode                                   && 出错提示代码
            
        * SysFreeString([EBP-10h])            
        * 释放由SysAllocString()分配生成BSTR字符串的空间
        cCode = cCode + 0h8B45F0                                    && MOV   EAX,[EBP-10h]
        cCode = cCode + 0h50                                        && PUSH  EAX
        cCode = cCode + 0hB8 + BINTOC(this.fSysFreeString, "4RS")   && MOV   EAX, fSysFreeString
        cCode = cCode + 0hFFD0                                      && CALL  EAX            调用SysFreeString()
    
        cCode = cCode + 0hB801000000                                && MOV   EAX,00000001h  返回1（.T.）
        **cCode = cCode + 0hB800000000                               && MOV   EAX,00000000h  返回0（.F.）
       
        cCode = cCode + 0h8BE5                                      && MOV   ESP,EBP              恢复栈顶指针
        cCode = cCode + 0h5D                                        && POP   EBP                  恢复ebp
    
        * 返回，按“堆栈平衡”原则，被调用者把堆栈指针修正到调用前的状态。
        * RET n参数个数*4，即 esp <- (esp + n参数个数*4)，因调用者首先把参数压入堆栈
        cCode = cCode + 0hC2 + BINTOC(nParameters * 4, "4RS")       && RET n参数个数*4
    
        nCount = ALEN(this.aPFunction) + IIF(!EMPTY(this.aPFunction[1]), 1, 0)    
        DIMENSION this.aPFunction[nCount]                        && 函数指针数组
        this.aPFunction[nCount] = apiMalloc(LEN(cCode))          && 分配函数代码内存空间
        SYS(2600, this.aPFunction[nCount], LEN(cCode), cCode)    && 载入函数代码 
        RETURN this.aPFunction[nCount]                           && 返回函数指针
    ENDFUNC
ENDDEFINE

[此贴子已经被作者于2022-3-20 14:57编辑过]

第 24 楼

得分:0

以下是引用sych在2022-3-19 08:18:49的发言：

俺是彻底矇圈，两眼发昏，不知该从哪行代码看起

在抽屉找出来的代码，我也没耐性改写下去。
因有FOX友提起VFP“回调函数”的问题，不认真回复就不好意思。
但不建议这样做，用VFP代码来写难得完善，有点不伦不类、本未倒置，有这功力完全可以将VFP先放在一边。

第 25 楼

得分:0

以下是引用cssnet在2022-3-19 11:29:15的发言：

前几天还批评我“截糊（结构体的16进制值）”不妥，好家伙，今天干脆自己“截糊”了几十行汇编16进制代码值。
呵呵呵呵。这个玩得有点大，有点夸张啦。
不予置评

也没法置评

我老人家实在是没有精力去翻罗云彬那一本《WINDOWS下32位汇编语言程序设计》

说“批评”，有点高抬我，过奖了。将事论事就好了，更何况是在这讨论问题的地方，只有辩论，没有争论，更没必要去批评人家。

记得没说过“截糊”有何“不妥”，只是相对“结构类型类”而论之长短，我回复你发的贴也是用类似“截糊”的串，咁快就唔记得啦，冇见我也经常用“串结构类型”写示例代码嘅咩。

发这个处女贴也是因你提的问题而起，算是给你破处了。为探讨如何提高VFP调用API的表达能力、减少出错、提高编程效率，失身当献身。

再论“截糊”，就当是截糊。此截糊非彼截糊，此截糊是针对指令，彼截糊是针对数据。指令是相对不变一次成形，数据是相对变动不回定。两者性质不同，不能一概而论。其实“截糊”行为是常态，尤其是写代码，最常不过 Ctrl+C、Ctrl+V 了。

罗云彬的《WINDOWS下32位汇编语言程序设计》，重点是 Windows API 编程。
王爽的《汇编语言》基本概念较全面。

第 26 楼

得分:0

回复 48楼 foxfans

C写的扩展，用其他编程语言扩展是硬道理。
能通用否，适应不同的 callbackproc?

第 27 楼

得分:0

以下是引用cssnet在2022-3-19 16:45:11的发言：

在VFP中调用机器代码，这实在太过尖端高科技了！就好比铁匠师傅烧旺火炉，夹块通红生铁，抡起大锤子，猛敲——铁匠师傅豪情万丈，要DIY敲一辆新能源电动小汽车出来！

当然，理论上，也不是绝对不可能；只不过，我觉得还是应当审慎地、静鸡鸡地建议铁匠师傅：

说，咱们敲敲马蹄铁、镰刀、菜刀之类就好啦，敲小汽车，怎么说咧——就显得有些不那么本分，不那么符合常理了吧？

哈哈哈哈。

类比虽是生动，要注意可比性，否则会给人感觉在偷换概念。
dBaseIII 时代就有个 CALL 命令调用汇编代码，其实多是用来调用 int（中断）功能，现在的说法就是调用API。
编程语言的话题，经常就有人说这门语言说那门语言，比这比那。不切实际，一点现实意义也没有。编程讲求的是思想，能表达出你的想法的语言就是好语言。

第 28 楼

得分:0

回复 52楼 foxfans

那个 callback.fll 载入不了? Win10 64位

[此贴子已经被作者于2022-3-19 20:26编辑过]

第 29 楼

得分:0

回复 57楼 foxfans

这个可以运行，但 EnumChildWindows 的 callbackproc 应该是有2个参数，你的是1个?
直觉这个FLL与我VFP写的大同小异
同样用VFP的测试

CallBack_test.rar (16.54 KB)

程序代码：

CLEAR
SET TALK OFF
SET SAFETY OFF
CLEAR ALL
cDefPath = ADDBS(JUSTPATH(SYS(16)))
SET DEFAULT TO (cDefPath)

**     
**    test.prg 
**     
SET PROCEDURE TO apiFuns.prg ADDITIVE
LoadApi() 

DECLARE integer CopyFileEx in Kernel32 string lpExistingFileName, string lpNewFileName,long lpProgressRoutine,long lpData,long pbCancel,long dwCopyFlags
DECLARE integer EnumChildWindows IN WIN32API integer hWnd, long lpEnumProc, long lParam
DECLARE Integer EnumFontFamilies IN gdi32 As EnumFontFamiliesA Integer hdc ,String lpszFamily ,Integer lpEnumFontFamProc,Integer lParam
DECLARE INTEGER GetDC IN WIN32API INTEGER hwnd

fa = CREATEOBJECT("FUNCTIONADDRESS")

pCallBackMyWindow=fa.GetFunAddr('MyWindow', 2)
pCallBackFontProc=fa.GetFunAddr('FontProc', 4)
pCallBackCopyProc=fa.GetFunAddr('CopyProc', 9)

EnumFontFamiliesA(GetDC(_vfp.hWnd),NULL,pCallBackFontProc,0)
EnumChildWindows(_vfp.hWnd,pCallBackMyWindow,0)
pbCancel=0
nRet=0
nRet=CopyFileEx("c:\temp\tmp.txt", "c:\temp\tmp2.txt", pCallBackCopyProc, 0, @pbCancel, 0)

SET PROCEDURE TO
CLEAR ALL
RETURN

Function CopyProc
    lparameters    TotalFileSize, TotalBytesTransferred,StreamSize, StreamBytesTransferred,StreamNumber,CallbackReason,SourceFile,DestinationFile,lpData
    ?TotalFileSize, TotalBytesTransferred, ;
                StreamSize, StreamBytesTransferred, ;
                StreamNumber, ;
                CallbackReason, ;
                SourceFile, ;
                DestinationFile, ;
                lpData
    return 0 
ENDFUNC

FUNCTION MyWindow
  lparameters hwnd,lparam 
  ?hwnd
  return 1
ENDFUNC

FUNCTION FontProc
    lparameters lpelfe as long,lpntme as long,fonttype as integer, lparam as long
    *!*?lpelfe,lpntme,fonttype,lparam
    logfont=sys(2600,lpelfe,28+33)
    newtextmetric=sys(2600,lpntme,17*4+1)
    facename=alltrim(right(logfont,33))
    facename=substr(facename,1,at(0h00,facename)-1)
    ? facename
    return 1
ENDFUNC

第 30 楼

得分:0

回复 59楼 foxfans

Win10 64 测试的， Win7没试过，
声明异常，是不是声明API函数时参数的数据类型问题。