标题:VFP封装结构类型示例
只看楼主
吹水佬
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:版主
威 望:432
帖 子:10064
专家分:41463
注 册:2014-5-20
得分:0 
以下是引用cssnet在2022-3-19 16:45:11的发言:

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

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

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

哈哈哈哈。

类比虽是生动,要注意可比性,否则会给人感觉在偷换概念。
dBaseIII 时代就有个 CALL 命令调用汇编代码,其实多是用来调用 int(中断)功能,现在的说法就是调用API。
编程语言的话题,经常就有人说这门语言说那门语言,比这比那。不切实际,一点现实意义也没有。编程讲求的是思想,能表达出你的想法的语言就是好语言。
2022-03-19 18:51
foxfans
Rank: 4
等 级:贵宾
威 望:11
帖 子:90
专家分:278
注 册:2021-10-23
得分:0 
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编辑过]

2022-03-19 19:07
吹水佬
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:版主
威 望:432
帖 子:10064
专家分:41463
注 册:2014-5-20
得分:0 
回复 52楼 foxfans
那个 callback.fll 载入不了? Win10 64位


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

2022-03-19 20:25
foxfans
Rank: 4
等 级:贵宾
威 望:11
帖 子:90
专家分:278
注 册:2021-10-23
得分:0 
看一下依赖库,是不是什么支持库win10没有。
2022-03-19 20:30
cssnet
Rank: 4
等 级:业余侠客
威 望:4
帖 子:317
专家分:203
注 册:2013-10-4
得分:0 
以下是引用吹水佬在2022-3-19 20:25:02的发言:
那个 callback.fll 载入不了? Win10 64位


这fll太古老了!用UltraEdit或WinHex打开,将0x174C的0x30改为0x31,才能在Win10 64位下用。
2022-03-19 21:49
cssnet
Rank: 4
等 级:业余侠客
威 望:4
帖 子:317
专家分:203
注 册:2013-10-4
得分:0 
话题既聊起了汇编,不由得忆起往昔峥嵘岁月稠……那时年少,血气方刚,记得曾雄心勃勃地拿着吴晓军的2.13H汇编代码,立志要通读学习一遍!可惜只看两天便放弃了。天分不够啊!江湖传闻说整个2.13就是吴晓军一只公拿Debug开发修改的!那时的大牛可真是牛得无以复加!几十年来,汇编偶尔我会用在“跟踪破解”上,虽说成功的案例少,失败的时刻多,不过也算是没白学过一点点皮毛罢。
2022-03-19 22:46
foxfans
Rank: 4
等 级:贵宾
威 望:11
帖 子:90
专家分:278
注 册:2021-10-23
得分:0 
回调函数.rar (7.6 KB)
 回调函数应用
2022-03-19 23:10
吹水佬
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:版主
威 望:432
帖 子:10064
专家分:41463
注 册:2014-5-20
得分: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 


2022-03-20 11:36
foxfans
Rank: 4
等 级:贵宾
威 望:11
帖 子:90
专家分:278
注 册:2021-10-23
得分:0 
win7 64位,ASM硬编码部分有问题,以前和行者孙有讨论过,空了我再找找,要微做处理,不然不同机器可能会报错。
回调函数的参数个数,实际上后面都不写都没事,只要你入几个参算好,回调几个也不会有问题,如果只取第一个参数,后面完全可以不写,只要堆栈平衡即可,因为不像hook,要更改其它的内容值。




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

2022-03-20 12:37
吹水佬
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:版主
威 望:432
帖 子:10064
专家分:41463
注 册:2014-5-20
得分:0 
回复 59楼 foxfans
Win10 64 测试的, Win7没试过,
声明异常,是不是声明API函数时参数的数据类型问题。
2022-03-20 13:44



参与讨论请移步原网站贴子:https://bbs.bccn.net/thread-508553-1-1.html




关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.080104 second(s), 8 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved