注册 登录
编程论坛 → VFP论坛

VFP封装结构类型示例

吹水佬 发布于 2022-03-14 21:53， 8832 次点击
近日，有贴谈到“调用Windows API时，如何正确地传递struct（结构体）参数”的问题。
连接：https://bbs.bccn.net/thread-508544-1-1.html

VFP调用API涉及到结构类型，通常是用字符串来表达结构类型成员数据，这方法看似简单，
但易读性差，很不好理解，尤其对初接触调用API的容易搞错。

封装结构类型的类，可提高VFP语言的表达能力，提高学习编程效率。

示例以 PARAFORMAT2 结构简单描述，对于复杂的结构体有待探讨

只有本站会员才能查看附件，请 登录

程序代码：
**    VFP封装结构类型示例
**    思路：
**    定义一个二维数组（aSTRUCT）用来描述结构体成员属性
**    每一行表达一个成员属性：名称（Name），类型（Type）, 大小（Size），地址偏移量（Offset）
**    定义 STRUCT_ARRAY 类，提供初始化结构成员属性函数 stInit()
**    定义 STRUCT_CALSS 类，提供读写结构成员数据函数 getValue()、setValue()

DECLARE long malloc IN msvcrt as apiMalloc long
DECLARE long free IN msvcrt as apiFree long
DECLARE long SendMessage IN user32 as apiSendMessage long,long,long,long

of = CREATEOBJECT("form1")
of.show(1)
CLEAR ALL
RETURN

DEFINE CLASS form1 as Form
    ADD OBJECT rich AS Olecontrol WITH top=10,left=10,width=200,height=200,OleClass="RICHTEXT.RichtextCtrl.1",visible=1
    PROCEDURE rich.init
        this.text = ""
        pf = CREATEOBJECT("PARAFORMAT2")
        st = CREATEOBJECT("STRUCT_CALSS", pf)
        st.setValue("cbSize", st.nSize)
        st.setValue("dwMask", 256)
        st.setValue("dyLineSpacing", 300)
        st.setValue("bLineSpacingRule", 4)
        #define WM_USER 0x0400
        #define EM_SETPARAFORMAT (WM_USER + 71)
        apiSendMessage(this.hWnd, EM_SETPARAFORMAT, 0, st.pBuffer)
        RELEASE st,pf
        this.text = "123456789"+0h0D0A+"abcdefghijk"+0h0D0A+"ABCDEFGHIJK"++0h0D0A
    ENDPROC
ENDDEFINE

DEFINE CLASS PARAFORMAT2 AS STRUCT_ARRAY
    PROCEDURE init
        DIMENSION this.aSTRUCT[24,4]
        this.stInit(1,  "cbSize",           "N",4)    && DWORD
        this.stInit(2,  "dwMask",           "N",4)
        this.stInit(3,  "wNumbering",       "N",2)    && WORD
        this.stInit(4,  "wEffects",         "N",2)
        this.stInit(5,  "dxStartIndent",    "N",4)
        this.stInit(6,  "dxRightIndent",    "N",4)
        this.stInit(7,  "dxOffset",         "N",4)
        this.stInit(8,  "wAlignment",       "N",2)
        this.stInit(9,  "cTabCount",        "N",2)
        this.stInit(10, "rgxTabs",          "C",128)  && DWORD[MAX_TAB_STOPS], MAX_TAB_STOPS=32
        this.stInit(11, "dySpaceBefore",    "N",4)
        this.stInit(12, "dySpaceAfter",     "N",4)
        this.stInit(13, "dyLineSpacing",    "N",4)
        this.stInit(14, "sStyle",           "N",2)
        this.stInit(15, "bLineSpacingRule", "N",1)    && BYTE
        this.stInit(16, "bOutlineLevel",    "N",1)
        this.stInit(17, "wShadingWeight",   "N",2)
        this.stInit(18, "wShadingStyle",    "N",2)
        this.stInit(19, "wNumberingStart",  "N",2)
        this.stInit(20, "wNumberingStyle",  "N",2)
        this.stInit(21, "wNumberingTab",    "N",2)
        this.stInit(22, "wBorderSpace",     "N",2)
        this.stInit(23, "wBorderWidth",     "N",2)
        this.stInit(24, "wBorders",         "N",2)
    ENDPROC
ENDDEFINE

DEFINE CLASS STRUCT_ARRAY AS Session
    DIMENSION aSTRUCT[1,4]
   
    PROCEDURE stInit(n, cName, cType, nSize)
        this.aSTRUCT[n,1] = cName
        this.aSTRUCT[n,2] = cType
        this.aSTRUCT[n,3] = nSize
        this.aSTRUCT[n,4] = IIF(n>1, this.aSTRUCT[n-1,3]+this.aSTRUCT[n-1,4], 0)
    ENDFUNC
ENDDEFINE

DEFINE CLASS STRUCT_CALSS AS Session
    stObj = NULL
    pBuffer = 0
    nSize = 0
   
    PROCEDURE init(stObj)
        this.stObj = stObj
        LOCAL nRowCount
        nRowCount = ALEN(this.stObj.aSTRUCT, 1)
        this.nSize = this.stObj.aSTRUCT[nRowCount,3] + this.stObj.aSTRUCT[nRowCount,4]
        this.pBuffer = apiMalloc(this.nSize)
        SYS(2600, this.pBuffer, this.nSize, REPLICATE(0h00,this.nSize))
    ENDPROC
   
    PROCEDURE Destroy
        apiFree(this.pBuffer)
    ENDPROC
   
    HIDDEN FUNCTION getRow(cName)
        LOCAL nRow
        nRow = ASCAN(this.stObj.aSTRUCT, cName)
        RETURN IIF(nRow>0, ASUBSCRIPT(this.stObj.aSTRUCT,nRow,1), 0)
    ENDFUNC
   
    FUNCTION getValue(cName)
        LOCAL n, nSize, nOffset, ret
        n = this.getRow(cName)
        IF n == 0
            RETURN NULL
        ENDIF
        nSize   = this.stObj.aSTRUCT[n,3]
        nOffset = this.stObj.aSTRUCT[n,4]
        RETURN ICASE(this.stObj.aSTRUCT[n,2]=="N", CTOBIN(SYS(2600, this.pBuffer+nOffset, nSize), TRANSFORM(nSize)+"RS"),;
                     this.stObj.aSTRUCT[n,2]=="C", SYS(2600, this.pBuffer+nOffset, nSize),;
                     NULL)
    ENDFUNC
   
    FUNCTION setValue(cName, vValue)
        LOCAL n, nSize, nOffset, ret
        n = this.getRow(cName)
        IF n == 0
            RETURN ""
        ENDIF
        nSize   = this.stObj.aSTRUCT[n,3]
        nOffset = this.stObj.aSTRUCT[n,4]
        IF this.stObj.aSTRUCT[n,2]=="N" AND VARTYPE(vValue)=="N"
            RETURN SYS(2600, this.pBuffer+nOffset, nSize, BINTOC(vValue, TRANSFORM(nSize)+"RS"))
        ELSE
            IF this.stObj.aSTRUCT[n,2]=="C" AND VARTYPE(vValue)=="C"
                vValue = LEFT(vValue, nSize)
                nSize = LEN(vValue)
                RETURN SYS(2600, this.pBuffer+nOffset, nSize, vValue)
            ENDIF
        ENDIF   
        RETURN ""
    ENDFUNC
ENDDEFINE
77 回复
#52
foxfans2022-03-19 19:07
CLEAR

#define PROGRESS_CONTINUE   0
#define PROGRESS_CANCEL     1
#define PROGRESS_STOP       2
#define PROGRESS_QUIET      3

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
set library to callback

pCallBackMyWindow=0
pCallBackFontProc=0
pCallBackMyWindow=0

pCallBackMyWindow=SetAddressOf('MyWindow', 'i')
pCallBackFontProc=SetAddressOf('FontProc', 'iiii')
pCallBackCopyProc=SetAddressOf( 'CopyProc', 'IIIIiiiii')

EnumFontFamiliesA(GetDC(_vfp.hWnd),NULL,pCallBackFontProc,0)
EnumChildWindows(_vfp.hWnd,pCallBackMyWindow,0)

pbCancel=0
nRet=0
nRet=CopyFileEx("c:\vfp9.0.rar", "c:\vfp9.0back.rar", pCallBackCopyProc, 0, @pbCancel, 0)

ReleaseAddressOf(pCallBackCopyProc)
ReleaseAddressOf(pCallBackMyWindow)
ReleaseAddressOf(pCallBackFontProc)

SET LIBRARY TO

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

FUNCTION MyWindow
  lparameters hwnd
  ?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

[此贴子已经被作者于2022-3-19 23:19编辑过]
#53
吹水佬2022-03-19 20:25
回复 52楼 foxfans
那个 callback.fll 载入不了? Win10 64位
只有本站会员才能查看附件，请 登录


[此贴子已经被作者于2022-3-19 20:26编辑过]
#54
foxfans2022-03-19 20:30
看一下依赖库，是不是什么支持库win10没有。
#55
cssnet2022-03-19 21:49
以下是引用吹水佬在2022-3-19 20:25:02的发言：
那个 callback.fll 载入不了? Win10 64位


这fll太古老了！用UltraEdit或WinHex打开，将0x174C的0x30改为0x31，才能在Win10 64位下用。
#56
cssnet2022-03-19 22:46
话题既聊起了汇编，不由得忆起往昔峥嵘岁月稠……那时年少，血气方刚，记得曾雄心勃勃地拿着吴晓军的2.13H汇编代码，立志要通读学习一遍！可惜只看两天便放弃了。天分不够啊！江湖传闻说整个2.13就是吴晓军一只公拿Debug开发修改的！那时的大牛可真是牛得无以复加！几十年来，汇编偶尔我会用在“跟踪破解”上，虽说成功的案例少，失败的时刻多，不过也算是没白学过一点点皮毛罢。
#57
foxfans2022-03-19 23:10
只有本站会员才能查看附件，请 登录
　回调函数应用
#58
吹水佬2022-03-20 11:36
回复 57楼 foxfans
这个可以运行，但 EnumChildWindows 的 callbackproc 应该是有2个参数，你的是1个?
直觉这个FLL与我VFP写的大同小异
同样用VFP的测试
只有本站会员才能查看附件，请 登录

程序代码：
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


#59
foxfans2022-03-20 12:37
win7 64位，ASM硬编码部分有问题,以前和行者孙有讨论过，空了我再找找，要微做处理，不然不同机器可能会报错。
回调函数的参数个数，实际上后面都不写都没事，只要你入几个参算好，回调几个也不会有问题，如果只取第一个参数，后面完全可以不写，只要堆栈平衡即可,因为不像hook,要更改其它的内容值。
只有本站会员才能查看附件，请 登录

只有本站会员才能查看附件，请 登录

只有本站会员才能查看附件，请 登录


[此贴子已经被作者于2022-3-20 12:53编辑过]
#60
吹水佬2022-03-20 13:44
回复 59楼 foxfans
Win10 64 测试的， Win7没试过，
声明异常，是不是声明API函数时参数的数据类型问题。
#61
吹水佬2022-03-20 13:55
其实VFP写的ASM码也是用几个API来处理，调用VFP的COM接口运行VFP函数。难道win7与win10的ASM码指令或寻址方式有所不同。
#62
csyx2022-03-20 23:46
有位前辈跟我说，不必浪费时间再造轮子。他老人家说 vfp2c32 中就有个函数叫 CreateCallbackFunc，这个 fll 可以到 github 上去搜索下载
#63
cssnet2022-03-21 11:59
以下是引用csyx在2022-3-20 23:46:38的发言：

有位前辈跟我说，不必浪费时间再造轮子。他老人家说 vfp2c32 中就有个函数叫 CreateCallbackFunc，这个 fll 可以到 github 上去搜索下载


是哦！一语惊醒梦中人！先前我就想起来“结构类在vfp2c32当中有现成的实现”：
https://bbs.bccn.net/viewthread.php?tid=508544&page=1#pid2758712
结果光顾着吹水，搞忘了这茬啦！
冇计，人老啦，记性唔好啦！
哈哈哈哈。
#64
吹水佬2022-03-21 12:17
以下是引用csyx在2022-3-20 23:46:38的发言：

有位前辈跟我说，不必浪费时间再造轮子。他老人家说 vfp2c32 中就有个函数叫 CreateCallbackFunc，这个 fll 可以到 github 上去搜索下载


一个用类来表达“结构类型”的话题，引来不少编程方面的讨论，感到有点意外和惊喜。

首先非常感谢 csyx 的关注和提出的问题，虽话语不多，但寓意深远。所以，很有必要对此问题展开一下讨论。

先说些看似与编程无相关的闲话，放松一下心情。再就编程方面说说自己的观点和看法。有点啰嗦，考验你的耐性了。

首先提到这位“老人家”，有话说“不听老人言，吃亏在眼前”，老人家的话一定要听进去，尤其是长辈的话。

记得做学生哥时听过一个关于两个数学家的故事，这两位数学家叫什么名字记不起来了，权当其中一位叫“高斯”吧：话说很久以前，有位数学家为解开一道数学难题，花了整整40年，难题终于被解开了，他兴奋之余，将解题过程和答案整理好寄给大数学家高斯。高斯收阅后即时回信，那位数学家收到高斯的回信，打开看后即时倒地不起了。据说回信内容是：我早在40多年前就解开这道难题了。这个故事大概内容就是这样，一笑过之。

相信不少FOX友是在新中国的前30年出生读书长大的，记得那句“造船不如买船，买船不如租船”被批判的洋奴哲学吗；还记得这30年之后的改革开放初期，曾经飞越过青藏高原的“运10”大飞机制造厂下马改造波音飞机的零部件；更还有的是又过30年之后，自己的大飞机又出厂起飞了，真是30年河东，30年河西。

法无定法，讨论问题不持肯定或否定态度。

“不听老人言，吃亏在眼前”，此言用在编程方面而论，这个 fll 会起到立杆见影的效果，搞钱来得快，不吃眼前亏。但是不是有 fll 用就可以安枕无忧、搞钱无尽呢? 如果是商品化的官方的 FLL 有保障性就好，否则就难保证出来的软件生命力有多长久，甚至是来历不明的 FLL，更有可能存在安全方面的问题。开发软件，这些问题都要得到重视，否则由此造成损失怕到时欲哭无泪。

经常也会见到使用 FLL 的人提起：以前用得好好的，系统更新了就不好使了。这是很正常的事，操作系统也没有百分百的兼容。但问题是此时一定要找到新版本的 FLL 支持，否则就如上术据说“欲哭无泪”，损失真是可大可小的。所以，在个人的立场上说，在欣赏人家美丽 FLL 的同时也要学点化妆技术来不断妆扮好自己，当感觉自己妆扮得比人家更美丽时，那种满足感不是能用时间或金钱换得来的。所以，“不必浪费时间再造轮子”，也是有局限性的，就如“运10”下马是为更快搞到钱，使老百姓先富起来，是历史的必然，好为现在大飞机重上天的技术储备提供支持。

说到写 Callback ，记得是好几年前了，在某论坛发表过一个贴是有关VFP多线程问题的，某论坛现在好象连自己发表的贴也查看不到了，是什么时候发表的无从证实。当时是用汇编写了个简单的函数接口给VFP作为线程过程接口来使用VFP的COM（支持多线程的COM）来运行VFP代码，使VFP也有多线程的能力。老实讲，这个多线程只是停在示例上，还真没实际应用过，因为没遇上必要性的机会。

VFP混合编程，目前常见类型有 DLL、FLL 和通过COM接口、脚本接口，如 JS、VBS 和 VBA 等。现在编程可真是门派林立，胶水式的编程语言成后起之秀，真是要集各门派之长方可成武林盟主。

无论是 DLL、FLL 还是之前回复的在VFP过程嵌入ASM，说到底原理都是一样的，都是在VFP进程里载入DLL、FLL、ASM的代码。也许有人当初认为在VFP过程写ASM有点不理解，我也说是另类，皆因写VFP的对ASM有兴趣的极少。编程方面肯定要优先考虑用DLL或FLL，易读好理解易调试好用开发高效；在PRG里体现ASM好处只有一个，短小精干，明码示众，源码开放，无安全性问题，缺点就不说了，就一句“乜都难”。





[此贴子已经被作者于2022-3-21 14:41编辑过]
#65
cssnet2022-03-21 14:55
以下是引用吹水佬在2022-3-21 12:17:32的发言：

“不听老人言，吃亏在眼前”……


大佬啊，vfp2c32是开源的！我觉得，与其一门心思地、执拗地、不管不顾地、大无畏地、一条道走到黑地……斋用VFP去辛辛苦苦摸索、实现，莫如直接将vfp2c32的CreateCallbackFunc源代码参参透，哪怕单独将这一小块抽离出来，写一个开源的Callback.fll，那也好过啊！

是吧，亲。
#66
sych2022-03-21 15:10
这个群里大佬应该合力把VFP搞起来
#67
cssnet2022-03-21 15:22
以下是引用cssnet在2022-3-21 14:55:41的发言：
vfp2c32的CreateCallbackFunc源代码参参透……


完啦！vfp2ccallback.cpp + vfp2ccallback.h，光代码就有1300+行，看着眼睛矇、脑壳疼——果断放弃！
今时今日，于我而言：
VFP是玩具，不再是揾食架撑（生产工具）。
#68
吹水佬2022-03-21 15:28
以下是引用cssnet在2022-3-21 14:55:41的发言：
大佬啊，vfp2c32是开源的！我觉得，与其一门心思地、执拗地、不管不顾地、大无畏地、一条道走到黑地……斋用VFP去辛辛苦苦摸索、实现，莫如直接将vfp2c32的CreateCallbackFunc源代码参参透，哪怕单独将这一小块抽离出来，写一个开源的Callback.fll，那也好过啊！

是吧，亲。

首先声明一点，从未针对 vfp2c32 说过什么，提到的 FLL 不是针对 vfp2c32，只是对 FLL 这东东提出自己的观点，这有何不妥?

重在理解，希望你重温我写的东东，注意不要断章取意就好。

VFP多语言编程有何不好? 我之前也有强调过，用在其他语言学到的东西应用到VFP里，这算是“一条道走到黑地……斋用VFP去辛辛苦苦摸索”吗? 这不是VFP论坛吗?不是重点探讨VFP编程的地方吗? 对你的理解表示遗憾！

如果不想讨论VFP的问题，可以到其他版块讨论，我可以陪同参与，那个版块也行，反正我是来学习的，编程是我的爱好。但有个小小要求：既然是讨论编程问题，尽量少用文字长篇大论，多用代码来表达体现编程的思想，这样可以高效地探讨交流编程心得。

自己开的贴啰嗦多几句也无可奈何，回复参与人的问题是态度问题，尽量抽空回敬。
#69
吹水佬2022-03-21 15:37
在BCCN有点看不明，VFP这个老古董的版块热度还真不小，最多人参与讨论实际问题的。曾经在Ｃ版块呆过一段时间，觉得连这Ｃ大佬的地盘讨论和解决实际问题的机会极少，多是出题目考人家的。
#70
cssnet2022-03-21 15:43
以下是引用吹水佬在2022-3-21 15:28:29的发言：
注意不要断章取意就好。……对你的理解表示遗憾！……回复参与人的问题是态度问题，尽量抽空回敬。


吹版您误会啦！误会啦！！
其实您的callback类，我根本已是看不懂了。
哪怕时光再倒流二十年——放在我青春年少风华正茂时也看不懂！更何况今时今日老眼昏花那就更看不懂者也！
在这里插科打诨、开开玩笑，没事就来搭几句话，那纯粹就是“友情帮顶”，没有一丝一毫恶意的，吹版切莫放在心上！
多多担待则个。
哈哈哈哈。
#71
radiofan2022-03-22 16:00
以下是引用吹水佬在2022-3-17 11:15:45的发言：

调用 WinApi 回避不了指针，有必要讨论一下指针的问题。

不少初接触指针的人，也感觉指针不好学、难把握好。可能是因为一开始接触的编程语言太高级，对指针感觉太抽象。想当年DOS时代也有用debug命令来写汇编生成com，没有什么变量名、数据类型等等高级货，全是与寄存器、地址打交道。建议学编程的一定要了解一下汇编，最起码能看得明白基本常用的代码。不论什么编程语言写出来的程序，机器码（汇编）是他的最终归宿。

指针，不管对新手还是老手来说，都有犯错的可能，这不奇怪，很正常的事。有个“C0000005”的异常代号应该不陌生，还有以前的Wndows蓝屏也是常事，这大都是指针的开放性不受约束带来的问题，编程的一不小心指针就会犯傻。所以，现在的高级编程语言也有不引入指针的概念，希望少犯傻。VFP也有涉及到指针的命令，如SYS(2600,,)，这命令会有可能犯傻的，之前就有贴讨论过这问题。

凡事要一分为二看，不要因指针会犯傻就不用。指针是个好东东，有时没他整不出好东东来。之前不久有贴讨论过从网页获取量大的JSON数据问题，用VFP字符串命令解释出全部数据要80多秒，放入JS对象解释要几秒，调用API用指针解释不到1秒，就是传说中的“秒杀”。所以，必要时该出手就要出手。

学习了！
#72
吹水佬2022-03-22 20:26
以下是引用cssnet在2022-3-21 15:22:25的发言：

完啦！vfp2ccallback.cpp + vfp2ccallback.h，光代码就有1300+行，看着眼睛矇、脑壳疼——果断放弃！
今时今日，于我而言：
VFP是玩具，不再是揾食架撑（生产工具）。

vfp真的极少必需要用到callback，API的callback通常都可以NULL，就算是多线程的线程过程，也有其他方法代替多线程。
既然在这提到 vfp to c 的 callback，就来点最精简示例代码参阅
vfpCallback_demo
只有本站会员才能查看附件，请 登录

程序代码：

CLEAR
CLEAR ALL
cDefPath = ADDBS(JUSTPATH(SYS(16)))
SET DEFAULT TO (cDefPath)
DECLARE Integer EnumFontFamilies IN gdi32 As EnumFontFamiliesA Integer hdc ,String lpszFamily ,Integer lpEnumFontFamProc,Integer lParam
DECLARE INTEGER GetDC IN WIN32API INTEGER hwnd
DECLARE LONG vfpGetFunAddr IN vfpCallback long,string@,long
pCallBackFontProc = vfpGetFunAddr(SYS(3095,_VFP), "FontProc", 4)
EnumFontFamiliesA(GetDC(_vfp.hWnd),NULL,pCallBackFontProc,0)
CLEAR ALL
RETURN

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

程序代码：

/*
    vfpCallback.cpp
    链接库 ole32、oleaut32
*/
//#define DLLIMPORT __declspec(dllexport)

#include <windows.h>
#include <stdio.h>

#define BUFSIZE 2048

GUID iid_IDispatch = {0x00020400,0x0000,0x0000,{0xC0,0x00,0x00,0x00,0x00,0x00,0x00,0x46}};
GUID iid_NULL      = {0x00000000,0x0000,0x0000,{0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00}};

IDispatch*  vfpIDispatch;
char        vfpFunname[BUFSIZE];
char        cmdbuf[BUFSIZE];

wchar_t* CharToWChar(const char *pChar, wchar_t *buf, size_t bufSize)
{
    size_t len = MultiByteToWideChar(CP_ACP, 0, pChar, strlen(pChar), NULL, 0);
    len = (bufSize<1 ? 0 : (len>bufSize-1 ? bufSize : len));
    MultiByteToWideChar(CP_ACP, 0, pChar, strlen(pChar), buf, len);
    buf[len] = '\0';
    return buf;
}

DISPID GetDispIDByName(IDispatch* This, const char* Name)
{
    LCID lcid = GetUserDefaultLCID();
    DISPID rgDispId;
    wchar_t pwStr[BUFSIZE];
    CharToWChar(Name, pwStr, BUFSIZE);
    BSTR rgszNames = SysAllocString(pwStr);
    HRESULT ret = This->GetIDsOfNames(iid_NULL,(LPOLESTR*)&rgszNames,1,lcid,&rgDispId);
    SysFreeString(rgszNames);
    if (ret == S_OK)
        return rgDispId;
    return 0;
}

BOOL Invoke(IDispatch* This, DISPID pid, DISPID* NamedArg, WORD wFlags, VARIANT *varg, UINT Args, VARIANT *var)
{
    LCID lcid = GetUserDefaultLCID();
    DISPPARAMS params = {NULL,NULL,0,0};
    if (varg != NULL)
    {
        params.rgvarg = varg;
        params.rgdispidNamedArgs = NamedArg;
        params.cArgs = Args;
         = (NamedArg ? 1 : 0);
    }
    return (This->Invoke(pid,iid_NULL,lcid,wFlags,&params,var,NULL,NULL)==S_OK);
}

BOOL InvokeMethod(IDispatch* This, const char* funName, VARIANT *varg, UINT Args, VARIANT *var)
{
    DISPID pid = GetDispIDByName(This, funName);
    if (pid < 0)
        return FALSE;
    return Invoke(This, pid, NULL, DISPATCH_METHOD, varg, Args, var);
}

LONG vfpDoCmd(IDispatch* vfpIDispatch, char* vfpCmd)
{
    char buffer[BUFSIZE];
    VARIANT var, params[10];
    LONG ret;
    //执行 _VFP 方法 DoCmd()
    params[0].vt      = VT_BSTR;
    params[0].bstrVal = SysAllocString(CharToWChar(vfpCmd, (wchar_t *)buffer, BUFSIZE));
    ret = InvokeMethod(vfpIDispatch, "DoCmd", params, 1, &var);
    SysFreeString(params[0].bstrVal);
    return ret;
}

BOOL CALLBACK vfpCallback(int p1,int p2,int p3,int p4)
{
    sprintf(cmdbuf, "%s(%d,%d,%d,%d)", vfpFunname,p1,p2,p3,p4);
    return vfpDoCmd(vfpIDispatch, cmdbuf);
}

extern "C" __declspec(dllexport) LONG vfpGetFunAddr(IDispatch* vfp, char* funname, BYTE params)
{
    vfpIDispatch = vfp;
    sprintf(vfpFunname, "%s", funname);
    return (LONG)vfpCallback;
}

BOOL WINAPI DllMain(HINSTANCE hinstDLL,DWORD fdwReason,LPVOID lpvReserved)
{
    return TRUE;
}
#73
schtg2022-03-23 05:58
@吹版，学习啦，非常感谢！
#74
吹水佬2022-03-23 07:42
对于FOX友初学C的用 DEV-CPP IDE 就基本可以满足要求。
用 DEV-CPP IDE 环境编译了一下，可以参考一下 Makefile.win 文件
程序代码：

# Project: vfpCallback
# Makefile created by Dev-C++ 5.11

CPP      = g++.exe
CC       = gcc.exe
WINDRES  = windres.exe
OBJ      = vfpCallback.o
LINKOBJ  = vfpCallback.o
LIBS     = -L"E:/__lyl/lyl/__C、C++/My Program/编程工具/Dev-Cpp/MinGW64/lib" -L"E:/__lyl/lyl/__C、C++/My Program/编程工具/Dev-Cpp/MinGW64/x86_64-w64-mingw32/lib32" -static-libgcc "E:/__lyl/lyl/__C、C++/My Program/编程工具/dev-cpp/mingw64/x86_64-w64-mingw32/LIB32/libole32.a" "E:/__lyl/lyl/__C、C++/My Program/编程工具/dev-cpp/mingw64/x86_64-w64-mingw32/LIB32/liboleaut32.a" -m32
INCS     = -I"E:/__lyl/lyl/__C、C++/My Program/编程工具/Dev-Cpp/MinGW64/include" -I"E:/__lyl/lyl/__C、C++/My Program/编程工具/Dev-Cpp/MinGW64/x86_64-w64-mingw32/include" -I"E:/__lyl/lyl/__C、C++/My Program/编程工具/Dev-Cpp/MinGW64/lib/gcc/x86_64-w64-mingw32/4.9.2/include"
CXXINCS  = -I"E:/__lyl/lyl/__C、C++/My Program/编程工具/Dev-Cpp/MinGW64/include" -I"E:/__lyl/lyl/__C、C++/My Program/编程工具/Dev-Cpp/MinGW64/x86_64-w64-mingw32/include" -I"E:/__lyl/lyl/__C、C++/My Program/编程工具/Dev-Cpp/MinGW64/lib/gcc/x86_64-w64-mingw32/4.9.2/include" -I"E:/__lyl/lyl/__C、C++/My Program/编程工具/Dev-Cpp/MinGW64/lib/gcc/x86_64-w64-mingw32/4.9.2/include/c++"
BIN      = vfpCallback.dll
CXXFLAGS = $(CXXINCS) -m32 -DBUILDING_DLL=1
CFLAGS   = $(INCS) -m32 -DBUILDING_DLL=1
RM       = rm.exe -f
DEF      = libvfpCallback.def
STATIC   = libvfpCallback.a

.PHONY: all all-before all-after clean clean-custom

all: all-before $(BIN) all-after

clean: clean-custom
    ${RM} $(OBJ) $(BIN) $(DEF) $(STATIC)

$(BIN): $(LINKOBJ)
    $(CPP) -shared $(LINKOBJ) -o $(BIN) $(LIBS) -Wl,--output-def,$(DEF),--out-implib,$(STATIC),--add-stdcall-alias

vfpCallback.o: vfpCallback.cpp
    $(CPP) -c vfpCallback.cpp -o vfpCallback.o $(CXXFLAGS)
#75
cssnet2022-03-23 18:15
以下是引用吹水佬在2022-3-22 20:26:34的发言：

vfp真的极少必需要用到callback，API的callback通常都可以NULL，就算是多线程的线程过程，也有其他方法代替多线程。
既然在这提到 vfp to c 的 callback，就来点最精简示例代码参阅
vfpCallback_demo


我顶你个肺啊！高手一出马，就知有没有！
真的很精简易懂哇，看得我老人家都不头晕了！
#76
吹水佬2022-03-25 08:39
以下是引用cssnet在2022-3-23 18:15:18的发言：

我顶你个肺啊！高手一出马，就知有没有！
真的很精简易懂哇，看得我老人家都不头晕了！

本来想再精简些，考虑到VFP不同版本的兼容性，还是从VFP的标准接口做起。
黑，继续黑下去，有必要考虑一下 Callback 过程的返回值。
通常 Callback 过程返回一个非零值（TRUE），Callback过程继续工作。返回零（FALSE），则Callback过程停止工作。
怎样从VFP的Callback函数处理Callback事件后将返回值返回给C的Callback过程作为 C Callback 的返回值?
简单做法：在C的Callback过程用一个存放返回值（ret）的地址连同其他参数一起传给VFP的Callback函数，VFP的Callback函数返回时将返回值写入这个ret地址空间。
只有本站会员才能查看附件，请 登录

VFP Callback
程序代码：

FUNCTION FontProc
    lparameters pRet as long,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)
    ? CTOBIN(SYS(2600,pRet,1),"1RS"), facename
    ret = 0  && 0 or 1
    SYS(2600, pRet, 1, BINTOC(ret,"1RS"))
    return ret
ENDFUNC

C Callback
程序代码：

BOOL CALLBACK vfpCallback(int p1,int p2,int p3,int p4)
{
    BOOL ret = 1;
    sprintf(cmdbuf, "%s(%u,%d,%d,%d,%d)", vfpFunname,&ret,p1,p2,p3,p4);    //vfp函数格式：fun(pRet,p1,p2,p3,p4)
    vfpDoCmd(vfpIDispatch, cmdbuf);
    return ret;    //返回非零值（TRUE），Callback过程继续工作。返回零（FALSE），则Callback过程停止工作。
}
#77
吹水佬2022-03-29 12:14
回复 39楼 csyx
简单整了个选择文件名或文件夹的对话框，没你用的好看。
只有本站会员才能查看附件，请 登录

只有本站会员才能查看附件，请 登录

程序代码：

cDefPath = ADDBS(JUSTPATH(SYS(16)))
SET DEFAULT TO (cDefPath)

DECLARE long strlen      IN msvcrt  as apiStrlen long
DECLARE long GetFileName IN vfpGetfile as apiGetFileName long,string@,string@

*
* 打开对话框
* GetFileName(hWnd, DefPath, Filter)
*
* 参数：hWnd ...... 所有者窗口句柄, 没有时为0。
*       DefPath ... 默认路径
*       Filter .... 文件类型格式过滤字符串。
*                   如文件格式选择列表：
*                       文本文件 ([color=#808080]*.txt)[/color]
*                       全部文件 ([color=#808080]*.*)[/color]
*                       Filter："文本文件([color=#808080]*.txt)\0*.txt\0全部文件(*.*)\0*.*\0"[/color]
*
* 返回：返回选择的文件名或文件夹，“取消”或选择无效的文件名时返回空串。
*
cFilter = "文本文件(*.txt)"+0h0+"*.txt"+0h0+"全部文件(*.*)"+0h0+"*.*"+0h0
pFile = apiGetFileName(_screen.hWnd, "c:\temp\test", cFilter)
? SYS(2600, pFile, apiStrlen(pFile))

CLEAR ALL
RETURN
#78
金太狼2024-06-01 09:19
支持吹版。
对于已有资源能够使用是一方面，能够明白它设计的初衷，以及能否发扬光大也是非常重要的。
每一次“创造或发明”都闪耀着新的思想和光芒，是非常宝贵的。
一个东西被创造出来了，也许看上去并不怎么样，但它从无到有的过程都是非常煎熬的，所以不要轻视任何的努力和付出。
12
©2025, BC-CN.NET
电脑版