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

#2

吹水佬2022-03-15 08:12

将 STRUCT_ARRAY 整合到 STRUCT_CALSSS，这样简洁些

程序代码：

**    VFP封装结构类型示例
**    思路：
**    定义一个二维数组（aSTRUCT）用来描述结构体成员属性
**    每一行表达一个成员属性：名称（Name），类型（Type）, 大小（Size），地址偏移量（Offset）
**    定义 STRUCT_CALSS 类，提供初始化结构成员属性、读写结构成员数据函数 stInit()、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")
        pf.setValue("cbSize", pf.nSize)
        pf.setValue("dwMask", 256)
        pf.setValue("dyLineSpacing", 300)
        pf.setValue("bLineSpacingRule", 4)
        #define WM_USER 0x0400
        #define EM_SETPARAFORMAT (WM_USER + 71)
        apiSendMessage(this.hWnd, EM_SETPARAFORMAT, 0, pf.pBuffer)
        RELEASE pf
        this.text = "123456789"+0h0D0A+"abcdefghijk"+0h0D0A+"ABCDEFGHIJK"++0h0D0A
    ENDPROC
ENDDEFINE

DEFINE CLASS PARAFORMAT2 AS STRUCT_CALSS
    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)
        STRUCT_CALSS::init
    ENDPROC
ENDDEFINE

DEFINE CLASS STRUCT_CALSS AS Session
    DIMENSION aSTRUCT[1,4]
    pBuffer = 0
    nSize = 0

    PROCEDURE init
        LOCAL nRowCount
        nRowCount = ALEN(this.aSTRUCT, 1)
        this.nSize = this.aSTRUCT[nRowCount,3] + this.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

    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

    HIDDEN FUNCTION getRow(cName)
        LOCAL nRow
        nRow = ASCAN(this.aSTRUCT, cName)
        RETURN IIF(nRow>0, ASUBSCRIPT(this.aSTRUCT,nRow,1), 0)
    ENDFUNC

    FUNCTION getValue(cName)
        LOCAL n, nSize, nOffset
        n = this.getRow(cName)
        IF n == 0
            RETURN NULL
        ENDIF
        nSize   = this.aSTRUCT[n,3]
        nOffset = this.aSTRUCT[n,4]
        RETURN ICASE(this.aSTRUCT[n,2]=="N", CTOBIN(SYS(2600, this.pBuffer+nOffset, nSize), TRANSFORM(nSize)+"RS"),;
                     this.aSTRUCT[n,2]=="C", SYS(2600, this.pBuffer+nOffset, nSize),;
                     NULL)
    ENDFUNC

    FUNCTION setValue(cName, vValue)
        LOCAL n, nSize, nOffset
        n = this.getRow(cName)
        IF n == 0
            RETURN ""
        ENDIF
        nSize   = this.aSTRUCT[n,3]
        nOffset = this.aSTRUCT[n,4]
        IF this.aSTRUCT[n,2]=="N" AND VARTYPE(vValue)=="N"
            RETURN SYS(2600, this.pBuffer+nOffset, nSize, BINTOC(vValue, TRANSFORM(nSize)+"RS"))
        ELSE
            IF this.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

#3

cssnet2022-03-15 11:18

用字符串来伪装struct，只要5行代码，而用类来封装模拟struct，则需要100+行代码，而且类代码比较艰深晦涩，还用到比较危险的malloc和free，我自己写C代码，都竭力避开手动内存分配，我敢打赌，至少80%、甚至90%以上的VFPer，看不懂这种类C代码；而且，比较要命的一点是：STRUCT_CALSS.init()需要VFPer手动填充，一个疏忽，也会跟构造“伪字符串”一样，因对不准结构成员数据宽度而出错。比如：

this.stInit(10, "rgxTabs", "C",128) && DWORD[MAX_TAB_STOPS], MAX_TAB_STOPS=32

这一行已超出了一般初学者能力范围，掰着手指头也数不过来它是4*32=128字节，一个不小心便会数错。说实话，当初我就根本就没查MAX_TAB_STOPS的值，仅仅笼统地计算了一下，用sizeof(PARAFORMAT2) - sizeof(PARAFORMAT) = 32，便“偷懒”跳过了PARAFORMAT结构体数据成员的大部分细节。对于相对简单的struct，比如PARAFORMAT2，小心翼翼构造出一个“伪字符串”来模拟struct，仍是“性价比”较高的做法；倘若是相对复杂的struct，比如指针成员，即使是用类封装，也十分困难，几近徒劳。

综上，个人初步结论是：

用类封装模拟struct，大大增加了代码长度与复杂度，而收效则并不特别明显——这投入与产出之间，不成比例，不是一件划算的交易……有些不太值得。

#4

吹水佬2022-03-15 11:51

回复 3楼 cssnet

从某方面说确实如此，尤其是不太熟悉调用 API 函数的人，甚至不清楚“结构类型”是什么也不足为奇，因VFP没有这方面是概念。

#5

antony5212022-03-15 11:53

回复 3楼 cssnet

那就再复杂点,设计容错性更好的class.

#6

吹水佬2022-03-15 12:23

回复 3楼 cssnet

“用字符串来伪装struct，只要5行代码，而用类来封装模拟struct，则需要100+行代码，而且类代码比较艰深晦涩”
编程不是代码越少越好是吧? 易读好理解的代码对程序的更新维护和交流好处多多，一个软件的发展过程更新维护占不少耗费的。

“还用到比较危险的malloc和free，我自己写C代码，都竭力避开手动内存分配”
malloc和free没那么恐怖吧，这对家伙是C语言最基本的东东，好多高级指令都是基于他的。只要能用好编程语言，不管是那门语言，提供是指令都可用。
当然，作为示例只能点到即止，简单调用malloc和free，没有考虑异常情况。

“比较要命的一点是：STRUCT_CALSS.init()需要VFPer手动填充，一个疏忽，也会跟构造“伪字符串”一样，因对不准结构成员数据宽度而出错。”
这点确实有点难为VFPer，看看C的头文件一大堆、里面声明的结构类型就明白，这不是三两日就写得出来、写得好的，所以说用C编程高大尚是有原因的。
平时用到的类封装起来，以后再用就简单了，如示例PARAFORMAT2类，再次引用直接CREATEOBJECT就OK了，不用每次都去构造“伪字符串”。

综上，个人初步结论是：
要扩展VFP这个老古董，就要下苦功。封装类，就是先苦后甜，不管学什么编程语言，道理一样。

#7

吹水佬2022-03-15 13:07

以下是引用cssnet在2022-3-15 11:18:48的发言：
倘若是相对复杂的struct，比如指针成员，即使是用类封装，也十分困难，几近徒劳。

虽然VFP没有指针的概念，但指针也好理解，当他是一个long变量也可以。
指针主要理解其两大特性：地址属性和大小属性。
不同类型的指针差别主要是大小属性，如字符类型指针大小属性为1byte、32位整数型指针大小属性为4byte

#8

laowan0012022-03-15 14:37

苦活累活交给类或函数去做，多花点精力也值得，省下了大把代码时间
当然，做成类、函数或是控件，得看具体要处理的问题而定，不能一概而论，只要做出来的东东快捷健壮就好

#9

cssnet2022-03-15 15:28

以下是引用吹水佬在2022-3-15 12:23:52的发言：
要扩展VFP这个老古董，就要下苦功。封装类，就是先苦后甜，不管学什么编程语言，道理一样。

其实最初我精心构造的“伪字符串”，本身就是正确无误的，后来吹版的回帖提醒了我：
敢情是我一不小心将SendMessage()声明写错了，最后一个参数应当是string@，而我随手复制/粘贴旧代码，平时用的一直是long。
故而哪怕调试到地老天荒，肯定一直报错“数据类型不匹配”！

之所以对于“用VFP类封装struct”持保留态度，那是因为后来冰雪聪明的我，找到了特别省事儿的独门秘笈（千万保密！千万保密！一般人我不告诉他！！切切。）——
只需打开VS调试一下C代码，在SendMessage()之前设个断点，先执行完前边几句：
  PARAFORMAT2 pf;
  pf.cbSize=sizeof(PARAFORMAT2); //识别paraformat与paraformat2
  pf.dwMask=PFM_LINESPACING;
  pf.dyLineSpacing=300; //行距在此设置
  pf.bLineSpacingRule=4;
然后，将结构pf的十六进制内存值的188字节复制下来，就能放到VFP中直接调用了——你说，那还搞甚么“类封装”那么复杂的东东作啥劳什子？！

聪明的，我问你。

#10

cssnet2022-03-15 15:48

你比方说，结构体pf的16进制值如下：

bc 00 00 00 00 01 00 00 cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc
cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc
cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc 2c 01 00 00 cc cc 04 cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc

将空格移除，头上再加个0h就能直接用了，试问——还花时间精力搞“类封装”作甚？！

#11

吹水佬2022-03-15 18:28

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

你比方说，结构体pf的16进制值如下：

bc 00 00 00 00 01 00 00 cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc
cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc
cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc 2c 01 00 00 cc cc 04 cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc cc

将空格移除，头上再加个0h就能直接用了，试问——还花时间精力搞“类封装”作甚？！

只针对个别的事情可以这样做.
成员复杂数据变动性大时，这样静态不断去截糊修改怕耗费也不小。
要对各成员非常了解才不容易搞错，因为可读性差（可以说是无可读性），搞错了也不容易发现和调试，以后更新维护就更不用说了，怕到时连自己也看不明。

封装成类，不是针对某一具体事情来做，是一个系统工程，一经封装就可以代代相传。
其实写个结构类也不是什么难的事，如：

程序代码：

MASM代码
PARAFORMAT2 STRUCT
  cbSize            DWORD    ?
  dwMask            DWORD    ?
  wNumbering        WORD     ?
  wEffects          WORD     ?

VFP代码
DEFINE CLASS PARAFORMAT2 AS STRUCT_CALS
    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)

形式都差不多，再看看 OPENFILENAME 结构类
DEFINE CLASS OPENFILENAME AS STRUCT_CALSS
    PROCEDURE init
        DIMENSION this.aSTRUCT[20,4]
        this.stInit(1,  "lStructSize",       "N",4)
        this.stInit(2,  "hwndOwner",         "N",4)
        this.stInit(3,  "hInstance",         "N",4)
        this.stInit(4,  "lpstrFilter",       "N",4)

PARAFORMAT2 与 OPENFILENAME 是不是有好多相似的地方，编写时好多都可以复制粘贴或搜索替换，稍作修改就OK。
使用时直接按成员名称读写就可以，清晰明了，易学易用不容易搞错，构造“伪字符串”是没法比的。

[此贴子已经被作者于2022-3-15 18:30编辑过]

#12

cssnet2022-03-15 21:15

以下是引用吹水佬在2022-3-15 18:28:21的发言：
要对各成员非常了解才不容易搞错，因为可读性差（可以说是无可读性），搞错了也不容易发现和调试，以后更新维护就更不用说了，怕到时连自己也看不明。

吹版说得对！
确实先前光顾着一个人爽啦，未考虑日后维护与可读性。
其实或许可以折中一下，兼顾可读性。
试考虑，这样子处理如何：
*---------------------------------
* 参照API的struct PARAFORMAT2，命名所需变量：
cbSize = 0x000000BC  &&（4字节：其值为结构体总长度 = 十进制188）
dwMask = 0x00000100  &&（4字节：其值为修改行距所对应的Mask = 十进制256）
dyLineSpacing = 0x0000012C  &&（4字节：其值为自己设置的行距值 = 十进制300，单位为twips）
bLineSpacingRule = 0x04  &&（1字节：其值意思是确定改行距的单位为twips）
* 用命名参数填充所需的结构成员，至于与我无关者一概忽略：
pf = BINTOC(cbSize,"4RS") + BINTOC(dwMask,"4RS") + REPLICATE(0h00,156);
   + BINTOC(dyLineSpacing,"4RS") + 0h0000 + BINTOC(bLineSpacingRule,"1RS") + REPLICATE(0h00,17)
*---------------------------------

如此，简洁明了且变量有注释，变量命名直指结构成员，而"4RS"、"1RS"也明确标注了字节长度，估计十年后也看得分明，看得懂啦——不知君意如何？

#13

吹水佬2022-03-15 21:26

以下是引用cssnet在2022-3-15 21:15:13的发言：

吹版说得对！
确实先前光顾着一个人爽啦，未考虑日后维护与可读性。
其实或许可以折中一下，兼顾可读性。
试考虑，这样子处理如何：
*---------------------------------
* 参照API的struct PARAFORMAT2，命名所需变量：
cbSize = 0x000000BC  &&（4字节：其值为结构体总长度 = 十进制188）
dwMask = 0x00000100  &&（4字节：其值为修改行距所对应的Mask = 十进制256）
dyLineSpacing = 0x0000012C  &&（4字节：其值为自己设置的行距值 = 十进制300，单位为twips）
bLineSpacingRule = 0x04  &&（1字节：其值意思是确定改行距的单位为twips）
* 用命名参数填充所需的结构成员，至于与我无关者一概忽略：
pf = BINTOC(cbSize,"4RS") + BINTOC(dwMask,"4RS") + REPLICATE(0h00,156);
   + BINTOC(dyLineSpacing,"4RS") + 0h0000 + BINTOC(bLineSpacingRule,"1RS") + REPLICATE(0h00,17)
*---------------------------------

如此，简洁明了且变量有注释，变量命名直指结构成员，而"4RS"、"1RS"也明确标注了字节长度，估计十年后也看得分明，看得懂啦——不知君意如何？

如果经常会用到结构类型都这样子来写，功夫还真有点强劲，少点气力也不成。那个字符串中的每个用“+”间隔的内容都要想清楚、计准确，够费神的。

#14

吹水佬2022-03-15 21:36

以下是引用cssnet在2022-3-15 11:18:48的发言：
倘若是相对复杂的struct，比如指针成员，即使是用类封装，也十分困难，几近徒劳。

就“指针成员”问题也写个示例，觉得没什么特别。

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

程序代码：

**
**    StructCalss.h
**
#define WM_USER             0x0400
#define MAX_PATH            260
#define EM_SETPARAFORMAT    (WM_USER + 71)

程序代码：

**
**    StructCalss.prg
**
DEFINE CLASS OPENFILENAME AS STRUCT_CALSS
    PROCEDURE init
        DIMENSION this.aSTRUCT[20,4]
        this.stInit(1,  "lStructSize",       "N",4)
        this.stInit(2,  "hwndOwner",         "N",4)
        this.stInit(3,  "hInstance",         "N",4)
        this.stInit(4,  "lpstrFilter",       "N",4)
        this.stInit(5,  "lpstrCustomFilter", "N",4)
        this.stInit(6,  "nMaxCustFilter",    "N",4)
        this.stInit(7,  "nFilterIndex",      "N",4)
        this.stInit(8,  "lpstrFile",         "N",4)
        this.stInit(9,  "nMaxFile",          "N",4)
        this.stInit(10, "lpstrFileTitle",    "N",4)
        this.stInit(11, "nMaxFileTitle",     "N",4)
        this.stInit(12, "lpstrInitialDir",   "N",4)
        this.stInit(13, "lpstrTitle",        "N",4)
        this.stInit(14, "Flags",             "N",4)
        this.stInit(15, "nFileOffset",       "N",2)
        this.stInit(16, "nFileExtension",    "N",2)
        this.stInit(17, "lpstrDefExt",       "N",4)
        this.stInit(18, "lCustData",         "N",4)
        this.stInit(19, "lpfnHook",          "N",4)
        this.stInit(20, "lpTemplateName",    "N",4)
        STRUCT_CALSS::init
    ENDPROC
ENDDEFINE

DEFINE CLASS PARAFORMAT2 AS STRUCT_CALSS
    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)
        STRUCT_CALSS::init
    ENDPROC
ENDDEFINE

DEFINE CLASS STRUCT_CALSS AS Session
    DIMENSION aSTRUCT[1,4]
    pBuffer = 0
    nSize = 0

    PROCEDURE init
        LOCAL nRowCount
        nRowCount = ALEN(this.aSTRUCT, 1)
        this.nSize = this.aSTRUCT[nRowCount,3] + this.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

    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

    HIDDEN FUNCTION getRow(cName)
        LOCAL nRow
        nRow = ASCAN(this.aSTRUCT, cName)
        RETURN IIF(nRow>0, ASUBSCRIPT(this.aSTRUCT,nRow,1), 0)
    ENDFUNC

    FUNCTION getValue(cName)
        LOCAL n, nSize, nOffset
        n = this.getRow(cName)
        IF n == 0
            RETURN NULL
        ENDIF
        nSize   = this.aSTRUCT[n,3]
        nOffset = this.aSTRUCT[n,4]
        RETURN ICASE(this.aSTRUCT[n,2]=="N", CTOBIN(SYS(2600, this.pBuffer+nOffset, nSize), TRANSFORM(nSize)+"RS"),;
                     this.aSTRUCT[n,2]=="C", SYS(2600, this.pBuffer+nOffset, nSize),;
                     NULL)
    ENDFUNC

    FUNCTION setValue(cName, vValue)
        LOCAL n, nSize, nOffset
        n = this.getRow(cName)
        IF n == 0
            RETURN ""
        ENDIF
        nSize   = this.aSTRUCT[n,3]
        nOffset = this.aSTRUCT[n,4]
        IF this.aSTRUCT[n,2]=="N" AND VARTYPE(vValue)=="N"
            RETURN SYS(2600, this.pBuffer+nOffset, nSize, BINTOC(vValue, TRANSFORM(nSize)+"RS"))
        ELSE
            IF this.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

FUNCTION LoadApi()
    DECLARE long malloc  IN msvcrt as apiMalloc long
    DECLARE long calloc  IN msvcrt as apiCalloc long,long
    DECLARE long free    IN msvcrt as apiFree   long
    DECLARE long _strdup IN msvcrt as apiStrdup string@
    DECLARE long strlen  IN msvcrt as apiStrlen long

    DECLARE long SendMessage IN user32 as apiSendMessage long,long,long,long

    DECLARE long GetOpenFileName IN comdlg32 long
    DECLARE long GetSaveFileName IN comdlg32 long
ENDFUNC

程序代码：

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

? myGetFileName(0, "C:\TEMP\__temp.txt", "Text Files (*.txt)|*.txt|All Files (*.*)|*.*", "打开文件", 0)
*? myGetFileName(0, "C:\TEMP\__temp.txt", "Text Files (*.txt)|*.txt|All Files (*.*)|*.*", "另存文件", 1, 0x80806)

SET PROCEDURE TO
CLEAR ALL
RETURN

*
* 打开对话框
* myGetFileName(hWnd, cDefFile, cType, cTitle, nDialogType, nFlags)
*
* 参数：hWnd .....。.... 指向所有者对话框窗口的句柄, 没有时为0。
*       cDefFile ....... 默认指定文件名
*       cType .......... 文件类型格式过滤字符串。
*                        如文件格式选择列表：
*
*                           [color=#0000FF]Text Files (*.txt)    [/color]
*                           [color=#808080]All Files (*.*)[/color]
*
*                           cType："[color=#0000FF]Text Files (*.txt)|*.txt|All Files (*.*)|*.*"[/color]
*
*       cTitle ........ 对话框标题
*
*       nDialogType ... 对话框类型，[color=#800000]0 选择打开文件， 1 选择另存文件[/color]
*
*       nFlags ........ 对话框的选项，参考 OPENFILENAME 结构成员 Flags 的描述。
*                       如不选择则按默认设置。
*
* 返回：返回选择的文件名，“取消”或选择无效的文件名时返回空串。
*
FUNCTION myGetFileName(hWnd, cDefFile, cType, cTitle, nDialogType, nFlags)
    LOCAL nBuffSize, of, pFile, pType, pTitle, ret, nLen, cPaht, cFiles

    nBuffSize = 80 * MAX_PATH             && 要有足够空间存放多个文件名。
    pFile = apiMalloc(nBuffSize)
    SYS(2600, pFile, LEN(cDefFile)+1, cDefFile+0h00)
    pType = apiMalloc(LEN(cType)+1)
    cType = STRTRAN(cType, "|", 0h00)     && 转为以0h00分隔
    SYS(2600, pType, LEN(cType)+1, cType+0h00)
    pTitle = apiStrdup(cTitle)

    IF EMPTY(nFlags)    && 设置默认值
        * 打开，0x80000|0x1000|0x4|0x200 = OFN_EXPLORER|OFN_FILEMUSTEXIST|OFN_HIDEREADONLY|OFN_ALLOWMULTISELECT
        * 另存，0x80000|0x800 |0x4|0x2   = OFN_EXPLORER|OFN_PATHMUSTEXIST|OFN_HIDEREADONLY|OFN_OVERWRITEPROMPT
        nFlags = IIF(nDialogType==0, 0x81204, 0x80806)
    ENDIF

    of = CREATEOBJECT("OPENFILENAME")
    of.setValue("lStructSize", of.nSize)
    of.setValue("hwndOwner",   hWnd)
    of.setValue("lpstrFilter", pType)
    of.setValue("lpstrFile",   pFile)
    of.setValue("nMaxFile",    nBuffSize)
    of.setValue("lpstrTitle",  pTitle)
    of.setValue("Flags",       nFlags)

    IF nDialogType==0
        ret = GetOpenFileName(of.pBuffer)
    ELSE
        ret = GetSaveFileName(of.pBuffer)
    ENDIF

    cFiles = ""

    IF ret > 0
        LOCAL ptr
        ptr = pFile
        nLen   = apiStrlen(ptr)    && pFile 以0h00分隔，以0h0000结束
        cFiles = SYS(2600, ptr, nLen)
        ptr = ptr + nLen + 1
        nLen   = apiStrlen(ptr)
        IF nDialogType==0 AND nLen > 0
            cPaht = ADDBS(cFiles)
            cFiles = ""
            DO WHILE nLen > 0        && 多选
                cFiles = cFiles  + cPaht + SYS(2600, ptr, nLen) + 0h0D0A
                ptr = ptr + nLen + 1
                nLen   = apiStrlen(ptr)
            ENDDO
            cFiles = RTRIM(cFiles,0h0D0A)
        ENDIF
    ENDIF

    apiFree(pFile)
    apiFree(pType)
    apiFree(pTitle)
    RETURN cFiles
ENDFUNC

[此贴子已经被作者于2022-3-17 15:13编辑过]

#15

cssnet2022-03-15 22:50

服——就一个字！
能将VFP玩到这样的程度，真心让人叹为观止！
讲真，今时今日，VFP对于我——相信对于论坛上很大一部分VFPer而言——也仅仅就是个仅供消遣的玩具，已不再能做到像十几、二十年前那样，费心费力去钻研、去挖掘VFP的艰深功能——事关，动力已没有，精力也不再允许了。
可，吹版展露出来的VFP功力，确是令人佩服啊！

#16

easyppt2022-03-16 08:27

吹版威武！

#17

吹水佬2022-03-16 09:12

以下是引用cssnet在2022-3-15 22:50:09的发言：

服——就一个字！
能将VFP玩到这样的程度，真心让人叹为观止！
讲真，今时今日，VFP对于我——相信对于论坛上很大一部分VFPer而言——也仅仅就是个仅供消遣的玩具，已不再能做到像十几、二十年前那样，费心费力去钻研、去挖掘VFP的艰深功能——事关，动力已没有，精力也不再允许了。
可，吹版展露出来的VFP功力，确是令人佩服啊！

VFP是面向对象编程，面向对象编程的核心是“类”，可以说无类不欢。

VFP原本只是一个桌面数据库集成系统，说是“集成系统”皆因其集数据库、人机交互（UI）于一身，麻雀虽小五脏俱全，基本运行库也只是几Ｍ，短小精干，运行效率高，易学易用，是一款开发高效的较为全面的入门学习编程语言。桌面数据库，他叫第二，就没叫第一。

只可惜，他英年早废，被时代抛弃。但只要windows支持32位应用，VFP还是会继续发光。

VFP编程语言与其他编程语言从语法结构上看本质上没什么区别，区别在于语言表达能力。如指针，VFP语言自身就没这说法，要VFP能使用指针就要提高VFP的表达能力。

幸运的是，VFP有表达 DLL 和 COM 的能力，windwos就有一大堆DLL和COM。可以说，理论上只要在windows能做到的，VFP也能做得到，能做多少就看对windows认识多少了。

也许看到这个时候，即时会问：VFP搞得那么深有必要吗?确实没必要，理性的就要选择更优秀开发平台。但，感性的对VFF爱不释手的通过在其他开发平台学到的返来帮助VFP提高表达能力，如写DLL扩展VFP功能，真是一家便宜两家着数，何乐而不为?

在BCCN发的处女贴，唠唠叨叨，啰啰嗦嗦，见谅！

#18

cssnet2022-03-16 10:53

以下是引用吹水佬在2022-3-16 09:12:24的发言：

如指针，VFP语言自身就没这说法，要VFP能使用指针就要提高VFP的表达能力。

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

#19

sam_jiang2022-03-16 19:00

类和结构有相似处，我觉得吹水佬提供的思路非常好。可以让人更好理解结构。

#20

吹水佬2022-03-17 06:46

以下是引用吹水佬在2022-3-15 21:36:41的发言：

程序代码：

    nBuffSize = 80 * MAX_PATH             && 要有足够空间存放多个文件名。
    pFile = apiMalloc(nBuffSize)
    SYS(2600, pFile, LEN(cDefFile)+1, cDefFile+0h00)
...............

    cFiles = ""

    IF ret > 0
        nLen   = apiStrlen(pFile)    && pFile 以0h00分隔，以0h0000结束
        cFiles = SYS(2600, pFile, nLen)
        pFile  = pFile + nLen + 1
        nLen   = apiStrlen(pFile)
        IF nDialogType==0 AND nLen > 0
            cPaht = cFiles
            cFiles = ""
            DO WHILE nLen > 0        && 多选
                cFiles = cFiles  + cPaht + "\" +  SYS(2600, pFile, nLen) + 0h0D0A
                pFile  = pFile + nLen + 1
                nLen   = apiStrlen(pFile)
            ENDDO
            cFiles = RTRIM(cFiles,0h0D0A)
        ENDIF
    ENDIF

    apiFree(pFile)

ENDFUNC

注意了！先截取上述示例部分相关代码，存在BUG。
有兴趣的可以先看看BUG在哪里

#21

sych2022-03-17 08:21

取不了目录

#22

吹水佬2022-03-17 08:38

以下是引用sych在2022-3-17 08:21:08的发言：

取不了目录

这个是取文件名对话框，取文件夹对话框是另一个API，有空可以写个示例。

#23

sych2022-03-17 08:47

为根目录的时候多一个“\”

#24

sych2022-03-17 08:56

    nBuffSize = 80 * MAX_PATH             && 要有足够空间存放多个文件名。
    pFile = apiMalloc(nBuffSize)
    SYS(2600, pFile, LEN(cDefFile)+1, cDefFile+0h00)
...............

    cFiles = ""

    IF ret > 0
        nLen   = apiStrlen(pFile)    && pFile 以0h00分隔，以0h0000结束
        cFiles = SYS(2600, pFile, nLen)
        pFile  = pFile + nLen + 1
        nLen   = apiStrlen(pFile)
        IF nDialogType==0 AND nLen > 0
            cPaht = addbs(cFiles)
            cFiles = ""
            DO WHILE nLen > 0        && 多选
                cFiles = cFiles  + cPaht +  SYS(2600, pFile, nLen) + 0h0D0A
                pFile  = pFile + nLen + 1
                nLen   = apiStrlen(pFile)
            ENDDO
            cFiles = RTRIM(cFiles,0h0D0A)
        ENDIF
    ENDIF

    apiFree(pFile)

ENDFUNC

#25

吹水佬2022-03-17 09:35

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

1、回调函数问题。是函数类型指针（函数指针）的问题，VFP是没有这概念，原因是解释语言，通常函数指针是静态编译的产物。
有兴趣可以试试用其他语言写个相对通用的接口来处理部分VFP需要的“回调函数”问题。

2、VFP调用API的必要性问题。试回想一下好多年前（或VFP的前身年代），VFP基本上都很少讨论API，因为那时VFP已经感觉到自己很强大。
随着时代的发展进步，VFP却遭遇不幸得不到相应的发展，在不少方面已经不适应时代要求，尤其是进入互联网时代，VFP自己也感觉有些力不从心了。这时候VFPer也很无奈。年轻有精力的可以另谋高就转行，但相信这时不少VFPer都奔5奔6，甚至有奔7，要这把年纪的去休掉VFP另娶谈何容易，也不现实。要吃饭，程序还是要做下去，只能深挖VFP的潜能，将《深入Windows核心编程》在VFP得到应用。

#26

吹水佬2022-03-17 09:42

以下是引用sych在2022-3-17 08:47:23的发言：

为根目录的时候多一个“\”

你截图来看看
我这未见异常

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

#27

吹水佬2022-03-17 11:15

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

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

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

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

#28

sych2022-03-17 11:17

回复 26楼吹水佬

单独选择一个文件时，正常
一次选择多个文件时，且是根目录下的文件时，会多一个“\”

#29

吹水佬2022-03-17 11:34

以下是引用sych在2022-3-17 11:17:53的发言：

单独选择一个文件时，正常
一次选择多个文件时，且是根目录下的文件时，会多一个“\”

确是，谢指正！

要改两句

程序代码：

        IF nDialogType==0 AND nLen > 0
            **cPaht = cFiles
            cPaht = ADDBS(cFiles)
            cFiles = ""
            DO WHILE nLen > 0        && 多选
                **cFiles = cFiles  + cPaht + "\" +  SYS(2600, pFile, nLen) + 0h0D0A
                cFiles = cFiles  + cPaht + SYS(2600, ptr, nLen) + 0h0D0A
                ptr = ptr + nLen + 1
                nLen   = apiStrlen(ptr)
            ENDDO
            cFiles = RTRIM(cFiles,0h0D0A)
        ENDIF

[此贴子已经被作者于2022-3-18 04:36编辑过]

#30

csyx2022-03-17 14:58

以下是引用吹水佬在2022-3-17 08:38:59的发言：
这个是取文件名对话框，取文件夹对话框是另一个API，有空可以写个示例。

期待早日看到同样风格的取文件夹功能，vfp的GetDir函数样式跟吹版的GetFile实在不协调

#31

吹水佬2022-03-17 15:08

以下是引用吹水佬在2022-3-17 06:46:37的发言：

注意了！先截取上述示例部分相关代码，存在BUG。

继续指针的问题
示例存在一个使用指针时出现的 BUG --- 内存泄漏。
这种使用指针的错误有时还真不容易发现，因为他不是运行到相关语句时就一定会抛出异常，也许运行到一定时间后会突然抛出类似“内存不足”、“内存分配错误”等等的异常。所以，这个问题一定要重视，平时使用指针要养成良好的习惯。

  主要相关语句：

1、pFile = apiMalloc(nBuffSize)
2、pFile  = pFile + nLen + 1
3、apiFree(pFile)

先简单了解一下堆内存分配和释放过程：
调用 Malloc 时分配一块连续的内存单元，并记录这块内存的首址，同时将首址返回给调用 Malloc 的过程存放在 pFile。
调用 Free 时释放一块内存，传入的参数 pFile 是由 Malloc 分配的这块内存首址，系统先在管理分配内存块的链表里查找地址是 pFile 记录，找到时就删除这条记录，释放被管制的内存空间，给再次 Malloc 时分配使用。
问题来了，要正常 Free 就要确保 pFile 是由 Malloc 分配的这块内存首址。这里有两点是重点：一是 Malloc 与 Free 必须是成对出现的，也就是说有 Malloc 必有 Free ；二是 pFile 一定要是由 Malloc 返回的首地址的值。
好了，现在问题就清晰了，出现 BUG 的语句就是：

  pFile  = pFile + nLen + 1

执行这句后 pFile 发生改变了，已经不是这块内存首址，当执行 Free 时已经无法找到由 Malloc 分配的这块内存记录，导致释放内存资源出现异常或不能释放造成“内存泄漏”。

要避免这类错误，一定要记住：保管好由 Malloc 返回的指针。
可以这样操作：

  pTmp = pFile
  pTmp = pTmp + nLen + 1
  nLen = apiStrlen(pTmp)
  cFiles = SYS(2600, pTmp, nLen)

东指指，西指指
都医不好我的痴
今晚只有一再心思思
永远单思

#32

nbwww2022-03-17 17:14

收藏先

#33

吹水佬2022-03-17 21:28

以下是引用csyx在2022-3-17 14:58:47的发言：

期待早日看到同样风格的取文件夹功能，vfp的GetDir函数样式跟吹版的GetFile实在不协调

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

只贴出新增加的代码，看看之前的贴出的代码自己分别加入 StructCalss.h 和 StructCalss.prg
头文件新增

程序代码：

** Browsing for directory.
#define BIF_RETURNONLYFSDIRS   0x0001  && For finding a folder to start document searching
#define BIF_DONTGOBELOWDOMAIN  0x0002  && For starting the Find Computer
#define BIF_STATUSTEXT         0x0004  && Top of the dialog has 2 lines of text for BROWSEINFO.lpszTitle and one line if
                                       && this flag is set.  Passing the message BFFM_SETSTATUSTEXTA to the hwnd can set the
                                       && rest of the text.  This is not used with BIF_USENEWUI and BROWSEINFO.lpszTitle gets
                                       && all three lines of text.
#define BIF_RETURNFSANCESTORS  0x0008
#define BIF_EDITBOX            0x0010  && Add an editbox to the dialog
#define BIF_VALIDATE           0x0020  && insist on valid result (or CANCEL)

#define BIF_NEWDIALOGSTYLE     0x0040  && Use the new dialog layout with the ability to resize
                                       && Caller needs to call OleInitialize() before using this API

#define BIF_USENEWUI           (BIF_NEWDIALOGSTYLE + BIF_EDITBOX)

#define BIF_BROWSEINCLUDEURLS  0x0080  && Allow URLs to be displayed or entered. (Requires BIF_USENEWUI)

#define BIF_BROWSEFORCOMPUTER  0x1000  && Browsing for Computers.
#define BIF_BROWSEFORPRINTER   0x2000  && Browsing for Printers
#define BIF_BROWSEINCLUDEFILES 0x4000  && Browsing for Everything
#define BIF_SHAREABLE          0x8000  && sharable resources displayed (remote shares, requires BIF_USENEWUI)

新增结构类

程序代码：

DEFINE CLASS BROWSEINFOA AS STRUCT_CALSS
    PROCEDURE init
        DIMENSION this.aSTRUCT[8,4]
        this.stInit(1,  "hwndOwner",      "N",4)
        this.stInit(2,  "pidlRoot",       "N",4)
        this.stInit(3,  "pszDisplayName", "N",4)
        this.stInit(4,  "lpszTitle",      "N",4)
        this.stInit(5,  "ulFlags",        "N",4)
        this.stInit(6,  "lpfn",           "N",4)
        this.stInit(7,  "lParam",         "N",4)
        this.stInit(8,  "iImage",         "N",4)
        STRUCT_CALSS::init
    ENDPROC
ENDDEFINE

新增API

程序代码：

    DECLARE LONG CoTaskMemFree IN Ole32 LONG

    DECLARE long ILCreateFromPath    IN shell32 string@
    DECLARE long SHBrowseForFolder   IN shell32 long
    DECLARE long SHGetPathFromIDList IN shell32 long, long

demo

程序代码：

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

? myGetDir("C:\temp")

SET PROCEDURE TO
CLEAR ALL
RETURN

FUNCTION myGetDir(cDefDir)
    LOCAL bi, pDir, cDir, pci, pit
    pDir = apiMalloc(MAX_PATH)

    cDefDir = STRCONV(ADDBS(cDefDir)+0h00, 5)
    pci = ILCreateFromPath(@cDefDir)

    bi = CREATEOBJECT("BROWSEINFOA")
    bi.setValue("pidlRoot",       pci)
    bi.setValue("pszDisplayName", pDir)
    bi.setValue("ulFlags",        BIF_BROWSEINCLUDEFILES)

    pit = SHBrowseForFolder(bi.pBuffer)

    IF pit > 0
        SHGetPathFromIDList(pit, pDir)
        cDir = SYS(2600, pDir, apiStrlen(pDir))
        CoTaskMemFree(pit)
    ENDIF
    CoTaskMemFree(pci)
    apiFree(pDir)
    RETURN cDir
ENDFUNC

#34

csyx2022-03-17 21:36

跟取文件对话框的Vista风格还是不统一呢，希望能整出一套风格统一的对话框，随便在网上找的两张图片，照说api可以整出取文件的，取文件夹的应该也能吧，只是我不会

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

[此贴子已经被作者于2022-3-17 21:39编辑过]

#35

吹水佬2022-03-17 21:47

回复 34楼 csyx

这个够强大的，VFP的表单应该就可以设计出来。
如果只是取文件夹或文件名，没必要搞得那么强大。

[此贴子已经被作者于2022-3-17 21:49编辑过]

#36

csyx2022-03-17 21:52

我们单位用的一套工资软件据我了解就是用vfp9写的，它的取文件和文件夹对话框就是统一的Vista风格，明天上班我截个图发上来给吹版参考下，以吹版的实力应该不难实现

#37

吹水佬2022-03-17 21:57

以下是引用csyx在2022-3-17 21:36:26的发言：
照说api可以整出取文件的，取文件夹的应该也能吧

不用API，就用VFP自己的设计器就可以，拉几个控件到表单，显示文件夹和文件用操作系统提供的列表框控件，VFP的命令就可以遍历文件夹和文件。

#38

吹水佬2022-03-17 22:03

回复 36楼 csyx

有可能是调用 windows shell 的类
这贴主要是探讨封装调用API时用到的“结构类型”类，借调用API举例，不是设计什么完整的功能模块。

#39

csyx2022-03-17 22:51

我让值班的同事给截了两张图，一张是指定备份文件的打开文件对话框，一张是指定备份路径的对话框，风格是统一的，那个打开文件对话框跟您的就一模一样，所以不会是用vfp表单做的，在不同的电脑上外观不同，但都跟Windows主题一致
我是弄不清咋做的，就希望能像调用vfp内置函数一样简单，能出来这个风格的对话框就好了
如果俺说的跑题了请见谅

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

图片缩小点，以免喧宾夺主

[此贴子已经被作者于2022-3-17 23:06编辑过]

#40

吹水佬2022-03-18 04:01

回复 39楼 csyx

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

#41

吹水佬2022-03-18 15:44

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

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

#42

吹水佬2022-03-18 23:15

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

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

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

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

只贴主要代码，打包下载

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

程序代码：

**
**    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编辑过]

#43

schtg2022-03-19 05:51

吹版，威武，辛苦啦，谢谢！

#44

sych2022-03-19 08:18

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

#45

吹水佬2022-03-19 09:27

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

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

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

#46

cssnet2022-03-19 11:29

以下是引用吹水佬在2022-3-15 18:28:21的发言：
只针对个别的事情可以这样做.
成员复杂数据变动性大时，这样静态不断去截糊修改怕耗费也不小。
要对各成员非常了解才不容易搞错，因为可读性差（可以说是无可读性），搞错了也不容易发现和调试，以后更新维护就更不用说了，怕到时连自己也看不明。

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

也没法置评

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

#47

吹水佬2022-03-19 15:18

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

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

也没法置评

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

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

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

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

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

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

#48

foxfans2022-03-19 16:18

回调函数

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

#49

cssnet2022-03-19 16:45

以下是引用吹水佬在2022-3-19 15:18:18的发言：
罗云彬的《WINDOWS下32位汇编语言程序设计》，重点是 Windows API 编程。
王爽的《汇编语言》基本概念较全面。

汇编语言，不是吹牛，我小时候还真的曾经自学过，今天勉强还能看懂汇编代码。当时读的是黄色封皮的《IBM-PC 汇编语言程序设计》，自己那时也没电脑，全凭一双眼、一副大脑，咬紧牙关强记下来，也没机会上机实操。那个年代自学电脑编程，纯粹就是在跟空气打交道！在草稿纸上写代码、反复地涂改、除虫，然而没有输入输出，没有调试，没有运行结果……总之一切的步骤，一条龙，全靠想象！

那还是1980～90年代吧……讲起来就比较长篇啰，一匹布咁长，暂且按下不表。

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

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

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

哈哈哈哈。

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

#50

吹水佬2022-03-19 17:58

回复 48楼 foxfans

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

#51

吹水佬2022-03-19 18:51

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

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

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

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

哈哈哈哈。

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