Netsuite for VFP 1.001 - 编程论坛

#2

easyppt2023-08-13 13:58

这是啥，介绍一下

#3

iswith2023-08-14 11:36

*--需要Netsuite.dll V1.002版支持
Clear
Public oPrinter
Local lcErrMsg
m.lcErrMsg  = ""
m.oPrinter  =  Createobject( "Netsuite.Printer")
?'获取当前指定打印机的状态:'
*!*    cStatus = "准备就绪（Ready）"
*!*    cStatus = "忙(Busy）"
*!*    cStatus = "门被打开（Printer Door Open）"
*!*    cStatus = "错误(Printer Error）"
*!*    cStatus = "正在初始化(Initializing）"
*!*    cStatus = "正在输入或输出（I/O Active）"
*!*    cStatus = "手工送纸（Manual Feed）"
*!*    cStatus = "无墨粉（No Toner）"
*!*    cStatus = "不可用（Not Available）"
*!*    cStatus = "脱机（Off Line）"
*!*    cStatus = "内存溢出（Out of Memory）"
*!*    cStatus = "输出口已满（Output Bin Full）"
*!*    cStatus = "当前页无法打印（Page Punt）"
*!*    cStatus = "塞纸（Paper Jam）"
*!*    cStatus = "打印纸用完（Paper Out）"
*!*    cStatus = "纸张问题（Page Problem）"
*!*    cStatus = "暂停（Paused）"
*!*    cStatus = "正在删除（Pending Deletion）"
*!*    cStatus = "正在打印（Printing）"
*!*    cStatus = "正在处理（Processing）"
*!*    cStatus = "墨粉不足（Toner Low）"
*!*    cStatus = "需要用户干预（User Intervention）"
*!*    cStatus = "等待（Waiting）"
*!*    cStatus = "正在准备（Warming Up）"
*!*    cStatus = "未知状态（Unknown Status）"
Local lcPrinterName
m.lcPrinterName = "Microsoft XPS Document Writer"
??m.oPrinter.GetPrinterStatus( m.lcPrinterName )

?'判断打印机是否在系统可用的打印机列表中:'
??m.oPrinter.PrinterInList( m.lcPrinterName )

?'指定的打印机设置以200mm*200mm为单位的自定义纸张(Form)成功否：'
Local lcPaperName;
    , lnWidthInMm;
    , lnHeightInMm
m.lcPaperName  = 'NetSuite V1.0 Paper'
m.lnWidthInMm  = 200
m.lnHeightInMm = 200
??m.oPrinter.AddPaper( m.lcPrinterName , m.lcPaperName , m.lnWidthInMm  , m.lnHeightInMm  , @m.lcErrMsg)

?'获取本地打印机列表:'
*可以通过制定参数获取网络打印机
?m.oPrinter.GetPrinterLists()

?'获取本机的默认打印机名称:'
??m.oPrinter.GetDeaultPrinterName()

?'设置默认打印机成功否:'
??m.oPrinter.SetPrinterToDefault( m.lcPrinterName )

?'判断打印机是否在系统可用的打印机列表中:'
??m.oPrinter.PrinterInList( m.lcPrinterName )

?'判断表单是否在指定的打印机所支持的纸张列表中,表单就是我们平常所说的纸张:'
??m.oPrinter.FormInPrinter(m.lcPrinterName , m.lcPaperName)

?'判断指定纸张的宽度:20cm和高度20cm和与打印内容指定的宽度和高度是否匹配:'
Local lnWidthcm ;
     ,lnHeightcm
m.lnWidthcm  = 20
m.lnHeightcm = 20
*只要整数位相同即认为是同一纸张，毕竟inch到cm的转换并不能整除
??m.oPrinter.FormSameSize(m.lcPrinterName , m.lcPaperName , m.lnWidthcm  , m.lnHeightcm  )

?'删除已经存在的自定义纸张:'
*??m.oPrinter.DeletePaper( m.lcPrinterName , m.lcPaperName ,@lcErrMsg )

Local loWXPayJSApi
m.loWXPayJSApi =  Createobject( "Netsuite.WXPayJSApi")

Local lcJson

appid         = ""         &&公众号ID
out_trade_no= ""         &&商户系统内部订单号，只能是数字、大小写字母_-*且在同一个商户号下唯一示例值：1217752501201407033233368018
mchid        = ""         &&商户号
serialNo     = ""         &&证书编号
privateKey  = ""         &&私钥不包括私钥文件起始的-----BEGIN PRIVATE KEY----- 亦不包括结尾的-----END PRIVATE KEY-----
openid      = ""        &&用户账号通过微信登陆授权后的 openid
url         = "https://api.mch.weixin.
*祥细查看：https://pay.weixin.

Text To m.lcJson Textmerge Noshow
{
    "mchid": "<<mchid>>",
    "out_trade_no": "<<out_trade_no>>",
    "appid": "<<appid>>",
    "description": "NetsuiteV1.0",
    "notify_url": "https://www.weixin.,
    "amount":{
                "total": 1,
                "currency": "CNY"
             },
    "payer":{
                "openid": "<<openid>>"
             }
}
Endtext
?m.loWXPayJSApi.postJson( url , m.lcJson , privateKey, mchid, serialNo )

*--需要Netsuite.dll V1.001版支持
Clear

public oFunction &&方便在命令行调试使用全局变量

Public lcErrorMsg    &&方便调试

m.oFunction  = Createobject( "Netsuite.Function")
m.lcErrorMsg     = ""

    ?'PingIpOrDomainName:[www.baidu.com]=' + Transform( m.oFunction.PingIpOrDomainName([www.baidu.com] , 2000 , @lcErrorMsg ) )+ ;
    '异常信息：' + m.lcErrorMsg

    ?'PingIpOrDomainName:[129.78.79.19]=' + Transform( m.oFunction.PingIpOrDomainName([129.78.79.19] , 2000 , @lcErrorMsg ) )+ ;
    '异常信息：' + m.lcErrorMsg

    ?'PingIpOrDomainName:[www.]=' + Transform( m.oFunction.PingIpOrDomainName([www.] , 2000 , @lcErrorMsg ) ) + ;
    '异常信息：' + m.lcErrorMsg

    ?'getmd5='             + m.oFunction.getMd5('zhz')

    ?'getOsver='           + m.oFunction.getOsver()

    ?'is64bitOs='          + Transform( m.oFunction.is64bitOs() )

    ?'isConnectInternet=' + Transform( m.oFunction.isConnectInternet() )

    ?'设置输入法：中文(简体) - 美式键盘'
     m.oFunction.SetInputLanguage("中文(简体) - 美式键盘")

    ?'isAdmin='                + Transform( m.oFunction.IsAdmin() )

    ?'返回当前EXE版本信息=' + Transform( m.oFunction.getFileVersionInfo() )  &&注意没有EXE版本号为Null

    ?'枚举系统全部进程信息='+ m.oFunction.getProcesses( @lcErrorMsg )    +;       &&注意有系统权限
     Iif( !Lower( alltrim( m.lcErrorMsg ) ) == Lower('Success' ) , '异常信息：' + m.lcErrorMsg , "" )

     *--关于SendMail 需要您设置“开启IMAP/SMTP服务”，拿到授权权码
    ?'sendmail='          + Transform( m.oFunction.SendMail( 'smtp.'             ; &&//服务器
                                                               , '今晚打老虎@'   ; &&//发件地址
                                                               , 'AABBCCDDEEFFGG'         ; &&//成功开启IMAP/SMTP服务，在第三方客户端登录时，登录密码输入以下授权密码
                                                               , '明晚打老虎@'   ; &&//收件地址
                                                               , 'test'                     ; &&//邮件标题
                                                               , '这是一个测试内容'     ; &&//邮件的内容
                                                               , @lcErrorMsg) )       + ;
    '异常信息：' + m.lcErrorMsg

    m.lcstrHtml  = '' &&应答响应的Html
    m.lcErrorMsg = '' &&错误信息
    m.lUrl         = [https://blog.]&&不对时自行找网址
    ?'获取外网IP:' + m.oFunction.HttpGetPageHtml(m.lUrl , @lcstrHtml, @lcErrorMsg )



     m.lcPstr        = [VFP变量做成指针:]
    ?'原字符串：' +  m.lcPstr  + + '  宽度：' +Transform( Len(m.lcPstr ) )
     m.lnoldLen       = Len( m.lcPstr )
     m.lnLen        = Len( m.lcPstr ) * 2
     m.lnDwAddress  = m.oFunction.VarPtr( m.lcPstr )&&这个函数默认为Unicode
    ?'VFP变量做成指针:' + Transform( m.lnDwAddress )
     m.lcPstr  =Sys( 2600 , m.lnDwAddress , m.lnLen )
    ?'Unicode: ' + m.lcPstr  + '  宽度：' +Transform( Len(m.lcPstr ) )                &&Unicode
     m.lcPstr  = strconv( m.lcPstr , 10 ) &&Unicode 字符转换为 UTF-8
    ?'UTF-8: ' + m.lcPstr  + '  宽度：' +Transform(Len(m.lcPstr ) ) &&UTF-8
     m.lcPstr  = strconv( m.lcPstr , 11 ) &&UTF-8 字符转换为双字节字符。
     m.lcPstr  = Left( m.lcPstr  , m.lnoldLen )
    ?'ASCII: ' + m.lcPstr + '  宽度：' +Transform(Len(m.lcPstr ))&&双字节字符



     ?'连字符分隔的32位字符串Guid:'                  + m.oFunction.GetGuid( )  &&连字符分隔的32位字符串
     ?'32位字符串(没有短横线)Guid:'                 + m.oFunction.GetGuid("N")&&32位字符串（没有短横线）
     ?'在大括号中、由连字符分隔的32位字符串Guid:'+ m.oFunction.GetGuid("B")&&在大括号中、由连字符分隔的32位字符串
     ?'在圆括号中、由连字符分隔的32位字符串Guid:'+ m.oFunction.GetGuid("P")&&在圆括号中、由连字符分隔的32位字符串
     ?'在圆括号中、由连字符分隔的32位字符串Guid:'+ m.oFunction.GetGuid("X")&&


      *Up  :网络接口已打开；它可以传输数据包
      *Down:网络接口无法传输数据包
     ?m.oFunction.GetMAC() &&返回全部本机的MAC列表格式如下：Name Up|Down Address


     Clear
     ?'AES待加密字符串：'
     Local lcstr
     m.lcstr = 'Netsuite.Function For ZHZ V1.0'
     ??m.lcstr
     ?'AES KEY:'
       Local lcAESKey
       m.lcAesKey =  m.oFunction.GetAESKey()
     ??m.lcAesKey

     ?"AES 加密："
      Local lcAESEncryptStr
      m.lcAESEncryptStr = m.oFunction.AESEncrypt( m.lcstr, m.lcAesKey )
     ??m.lcAESEncryptStr

     ?"AES 解密：" + m.oFunction.AESDecrypt(m.lcAESEncryptStr , m.lcAesKey )


     Clear
     ?'3DES待加密字符串：'
     m.lcstr = 'Netsuite.Function For ZHZ V1.0'
     ??m.lcstr
     ?'密钥,必须32位:'
      Local lc3DESKey
      m.lc3DESKey  = "qJzGEh6hESZDVJeCnFPGuxzaiB7NLQM5"
     ??m.lc3DESKey

     *必须是12个字符
      Local lcsIV
      lcErrorMsg = ''
      m.lcsIV    = "andyliu1234="
      Local lc_3DEsDecryptstring
      lc_3DEsDecryptstring  =   m.oFunction._3DEsEncrypt( m.lcstr , m.lc3DESKey  , lcsIV ,@lcErrorMsg  )
      ?"3DES加密后:" + lc_3DEsDecryptstring  + Iif( Empty( lcErrorMsg  ) , '' , '错误：' + m.lcErrorMsg  )

      lc_3DEsDecryptstring  =   m.oFunction._3DEsDecrypt( lc_3DEsDecryptstring, m.lc3DESKey  , lcsIV ,@lcErrorMsg  )
      ?"3DES解密后:" + lc_3DEsDecryptstring  + Iif( Empty( lcErrorMsg  ) , '' , '错误：' + m.lcErrorMsg  )


      Local loRSA      ;
            , lnKeySize;
            , xml         ;
            , pem_pkcs1;
            , pem_pkcs8

      *从DLL中获取RSA
      m.lnKeySize = 512 &&1024
      m.loRSA       = oFunction.GetRSA( m.lnKeySize )
      Clear
      ?Transform(lnKeySize) + '私钥(xml):'
       xml = m.loRSA.ToXML()
      ??xml
      ?Transform(lnKeySize) + '私钥(PKCS#1):' &&用于解密(加密需要私钥需要最强大的第三方DLL....)
       pem_pkcs1 = m.loRSA.ToPEM().ToPEM_PKCS1()
      ?pem_pkcs1
      ?Transform(lnKeySize) + '公钥(PKCS#8):' &&用于加密
       pem_pkcs8 = m.loRSA.ToPEM().ToPEM_PKCS8()
      ?pem_pkcs8
      ?'RSA待加密字符串：'
        m.lcstr =  'Netsuite.Function For ZHZ V1.0'
      ??m.lcstr
      ?'RSA加密:'
        Local lcenstr
        m.lcenstr = m.loRSA.Encode( m.lcstr )
      ??m.lcenstr
      ?'RSA解密:'
        m.lcdestr = m.loRSA.DecodeOrNull( m.lcenstr)

      ?'签名SHA1:'
        Local lcsign
        m.lcsign = m.loRSA.Sign("SHA1", m.lcstr )
        ??m.lcsign
      *m.loRSA.Sign("SHA224", m.lcstr )没有,以后再补
      *m.loRSA.Sign("SHA256", m.lcstr )有
      *m.loRSA.Sign("SHA384", m.lcstr )没有,以后再补
      *m.loRSA.Sign("SHA512", m.lcstr )没有,以后再补
      *m.loRSA.Sign("SHA3"  , m.lcstr )没有,以后再补
      ??m.lcsign
      ?'校验签名：'
      ??m.loRSA.Verify("SHA1", m.lcsign, m.lcstr)


      *用pem文本创建RSA
      Local loRSA2
      m.loRSA2= oFunction.GetRSA2( pem_pkcs8 )
      ?'用PEM公钥(PKCS#8)新创建的RSA是否和上面的一致：'
      ?'XML:'
      ??m.loRSA2.ToXML() == m.loRSA.ToXML()
      ?'PKCS1：'
      ??m.loRSA2.ToPEM().ToPEM_PKCS1() == m.loRSA.ToPEM().ToPEM_PKCS1()
      ?'PKCS8:'
      ??m.loRSA2.ToPEM().ToPEM_PKCS8() == m.loRSA.ToPEM().ToPEM_PKCS8()

      *用xml文本创建RSA
      Local loRSA3
      m.loRSA3= oFunction.GetRSA3( xml )
      ?'用xml文本新创建的RSA是否和上面的一致：'
      ?'XML:'
      ??m.loRSA3.ToXML() == m.loRSA.ToXML()
      ?'PKCS1：'
      ??m.loRSA3.ToPEM().ToPEM_PKCS1() == m.loRSA.ToPEM().ToPEM_PKCS1()
      ?'PKCS8:'
      ??m.loRSA3.ToPEM().ToPEM_PKCS8() == m.loRSA.ToPEM().ToPEM_PKCS8()

      *第四种方法通过公钥指数和私钥指数构造一个PEM，;
      会反推计算出P、Q但和原始生成密钥的P、Q极小可能相同,就不写了先记着
      Local loRSA4
      *<param name="modulus">必须提供模数</param>
      *<param name="exponent">必须提供公钥指数</param>
      *<param name="dOrNull">私钥指数可以不提供，导出的PEM就只包含公钥</param>
      *可以使用16进制 byte[]
      *m.loRSA4= oFunction.GetRSA4( byte[] modulus , byte[] exponent ,byte[] dOrNull)

*--需要Netsuite.dll V1.001版支持
*--如: 将VFP的cursor导入MSSQL
*--如：SQL服务器在本机
*--要使用本DemO需要在MSSQL建立表“test” 目录：\testdata\test.sql 有表结构脚本
Local lcstrOledbConn       ;
    , lcstrSQLServertConn  ;
    , lcSql                   ;
    , lcFilename           ;
    , lnTimeOut               ;
    , lisIdentity            ;
    , lnBatchSize           ;
    , lnRowcount           ;
    , lnColCount            ;
    , lcErrorMsg           ;
    , lntimeStart          ;
    , loBulkCopy               ;
    , lcPath

Local lcPath
If _vfp.StartMode = 0 Then
   m.lcPath = Addbs( Justpath( _vfp.ActiveProject.Name  ))
Else
   m.lcPath = Addbs( Justpath( sys(16,0) )  )
Endif

*--需要WebView2.DLL V.105版支持
*--这是一个收费功能函数,不需要可以不关注
*--如：导入DBF
*--如：SQL服务器在本机
*--要使用本DemO需要在MSSQL建立表“test” 目录：\testdata\test.sql 有表结构脚本
*--耗时
m.lntimeStart           = Seconds()

*--SQL连接配置信息
m.lcstrSQLServertConn   = [uid=sa; pwd=1234567;Database=autoparts;Server=127.0.0.1;Connect Timeout = 50; Max Pool size=1024;Min pool Size=5]

*--VFP OLE DB 配置信息
m.lcstrOledbConn        = [provider=VFPOLEDB.1;data source=] + lcPath +  [testdata\;user id=admin;password=]

m.lnTimeOut             = 60        &&超时秒数
m.lnBatchSize            = 10000     &&BatchSize
m.lisIdentity             = .F.        &&是否导入到SQL表时重新生成ID
m.lnRowcount            = 0            &&地址回参返回导入行数
m.lnColCount             = 0            &&地址回参返回导入列数
m.lcErrorMsg            = ""        &&错误信息

*--实例化类
m.loBulkCopy  = Createobject( "Netsuite.BulkCopy")

*--查询语句
Text To m.lcSql Textmerge  noShow
        Select id,pano,pana,orig,md From test.dbf
Endtext

*--执行(成功=.T. |失败-.F.)
If m.loBulkCopy.SQLBulkInsert( 'test'                ;  &&SQL导入的表名
                             , m.lnTimeOut             ;  &&超时时间
                             , m.lnBatchSize         ;  &&多少条一个批次
                             , m.lisIdentity         ;  &&是否导入到SQL表时重新生成ID
                             , m.lcstrOledbConn        ;  &&预导入文件的OLE驱动配置信息
                             , m.lcstrSQLServertConn;  &&与SQLServer连接配置信息
                             , m.lcSql                ;  &&用什么VFP SQL语句去抓取本地磁盘文件上传到SQLServer
                             , @lnRowcount            ;  &&成功导入多少行
                             , @lnColCount             ;  &&成功导入多少列
                             , @lcErrorMsg )

    Messagebox( '导入MSSQL耗时：' + Transform( Seconds()    - m.lntimeStart   ) + '记录数：' + Transform( m.lnRowcount    ) , 64 )
Else
    Messagebox( m.lcErrorMsg , 16 , 'SqlBulkcopy' )
Endif
*--需要Netsuite.dll V1.001版支持
*--函数设计是开放式的并没有把任何有关联的设计绑定到一起;
   您可以很自由的再包装在一起为一个VFP函数执行
*--同时支持IP6,IP4
*--Pasv模式（被动）
*--文件列表兼容Windows与Unix格式(实际我则试的是windows Dos格式为Unix格式）
*--Ftp协议是公开的……远程主机强制关闭了一个现有的连接这样的网络问题你应该使用;
   Try Enctry捕获到并且重试,因为这不是C端sock引发的！而是服务器下发的动作,DLL中可能已包含尝试10次的连接;
   ，如果失败需要你使用Try 来捕捉这个错误,再次重试，只到排除错误重试成功。

Clear

Public oFTP &&因FTP函数之间有一定的上下文联系，所以设置为Public 方便test

oFTP =Createobject("Netsuite.FTPClient")

Local ftpServerIP       as String ;
    , remoteFilePath  as String ;
    , ftpUserID       as string ;
    , ftpPassword     as string ;
    , ftpServerPort   as int    ;
    , ErrMsg          as String ;
    , anonymousAccess as Boolean &&默念为False


*--按设计只初始化一次或下面属性设置好，然后才能单独去执行函数。
*--下面的单独函数不用每次都初始化

*--方法一(FTP初始化)
*!*    oFTP.ftpServerIP    = [94.191.35.151]  &&FTP服务器IP地址
*!*    oFTP.remoteFilePath = []                 &&当前服务器目录zhztest
*!*    oFTP.ftpUserID      = [zhzuser]           &&Ftp 服务器登录用户账号
*!*    oFTP.ftpPassword    = [zhz123456]        &&Ftp 服务器登录用户密码
*!*    oFTP.ftpServerPort  = [21]               &&FTP服务器端口
*!*    ErrMsg                = []               &&地址回参错误信息每个函数都可以捕捉错误信息
*!*    lReturn                = oFTP.Connect( @ErrMsg )

*--方法二(FTP初始化)
ftpServerIP    = [94.191.35.151]  &&FTP服务器IP地址
remoteFilePath = []                    &&当前服务器目录zhztest
ftpUserID      = [zhzuser]          &&Ftp 服务器登录用户账号
ftpPassword    = [Pq6pOKeV]       &&Ftp 服务器登录用户密码
ftpServerPort  = [21]              &&FTP服务器端口
ErrMsg           = []                  &&地址回参错误信息每个函数都可以捕捉错误信息
lReturn = oFTP.FTPClientInit(ftpServerIP   , remoteFilePath , ftpUserID   , ftpPassword  , ftpServerPort , @ErrMsg )

?'FTP连接=' + Iif( lReturn , '成功' , '异常信息：' + ErrMsg )

If !lReturn  Then
    Return .F.
Endif

*--SetTransferType 设置传输模式
*--传输模式:0=二进制类型(默认);1=ASCII类型
Local loEx
Try
    ErrMsg           = []                  &&地址回参错误信息每个函数都可以捕捉错误信息
    ?"SetTransferType=" + Transform( oFTP.SetTransferType( 0 , @ErrMsg ) )+ ;
    '异常信息：' + ErrMsg
Catch To m.loEx
Endtry

If Type("loEx.Message" ) == "C" Then
   ? '异常信息：' + m.loEx.Message
   Return .F.
Endif

*--MkDir 创建目录(如果已有就不能创建)
strDirName= [unload] &&目录名
ErrMsg       = []
lReturn   = oFTP.MkDir( strDirName , @ErrMsg )
?'MkDir创建目录=['+ Iif( lReturn , strDirName , '异常信息：'  + ErrMsg ) + ']'

*--ChDir 改变当前目录
Public NowstrDirName
NowstrDirName= [\unload] &&新的工作目录名 [.\] 往上一层
ErrMsg          = []
lReturn      = oFTP.ChDir ( NowstrDirName    , @ErrMsg )
?'ChDir改变目录=['+ Iif( lReturn , NowstrDirName , '异常信息：'  + ErrMsg ) + ']'

*--MkDir 创建目录(如果已有就不能创建)
For m.lncount = 1 To 10
    strDirName= [test] + Transform( m.lnCount ) &&目录名
    ErrMsg       = []
    lReturn   = oFTP.MkDir( strDirName , @ErrMsg )
    ?'MkDir创建目录=['+ Iif( lReturn , NowstrDirName + [\] + strDirName , '异常信息：'  + ErrMsg ) + ']' + Replicate( Chr(13) , 2 )
Endfor

*--RmDir 删除目录(注意无法删除在当前目录)
strDirName= [test10] &&目录名
ErrMsg       = []
lReturn   = oFTP.RmDir( strDirName , @ErrMsg )
?'RmDir删除目录=['+ Iif( lReturn , NowstrDirName + [\] + strDirName, '异常信息：'  + ErrMsg ) + ']'     + Replicate( Chr(13) , 2 )

*--Dir 获得文件列表(注意因FTP服务器不同列表格式是不一样的，这里取回来是原始列表
      *该列表的格式将取决于ftp服务器的操作系统,你需要在VFP重新解析该格式
strMask  = [*.*] &&文件名的匹配字符串
ErrMsg      = []    &&错误信息
Lists    = oFTP.Dir( strMask, @ErrMsg )
?'Dir获得文件列表=' + Chr(10) + Iif( Empty(ErrMsg ) ,  Lists , '异常信息：'      + ErrMsg     ) + Replicate( Chr(10) , 2 )
ALINES( ArrayFileLists , Lists )

*--GetFileTime 获得文件最后修改时间字符串
strFileName    = [\unload\unins000.dat]     &&文件名的匹配字符串
ErrMsg         = []                        &&返回值string
lcDateTime  = oFTP.GetFileTime( strFileName , @ErrMsg )
?'GetFileTime获得文件最后修改时间=' + Iif( Empty( ErrMsg ) , lcDateTime , '异常信息：'      + ErrMsg ) + Replicate( Chr(10) , 2 )

*--Upload 上传一个文件
nHtTime          = Seconds()
strFileName         =[C:\WebView2\testdata\test.sql]  &&本地文件名
lnSize           = Fsize( strFileName )
ErrMsg              =[]
lReturn          = oFTP.Upload ( strFileName, @ErrMsg )
?'Upload上传一个文件=' + Iif( lReturn , strFileName  + '(' +Transform(  lnSize /1024 /1024 ) + 'MB' + ',耗时:' + Transform( Seconds() - m.nHtTime )+')'              ;
                                      , '异常信息：' + m.ErrMsg   ) + Replicate( Chr(10) , 2 )

*--Rename 重命名(如果新文件名与已有文件重名,将覆盖已有文件)
strOldFileName= justFname(strFileName)                           &&旧文件名
strNewFileName= Justfname( Forcepath( Sys(2015) ,strFileName ) ) &&新文件名
ErrMsg           = []                                                 &&错误信息
lReturn       = oFTP.Rename( strOldFileName    , strNewFileName, @ErrMsg )
?'Rename重命名='       + Iif( lReturn , NowstrDirName + [\] + strOldFileName + [->>>] + NowstrDirName + [\] + strNewFileName +' - 成功' ;
                                     , '异常信息：'     + m.ErrMsg     ) + Replicate( Chr(10) , 2 )

*--GetFileSize 获取文件大小
nFileSize    = oFTP.GetFileSize( strNewFileName , @ErrMsg   )
?'GetFileSize 获取文件大小=' + Iif( Empty( ErrMsg ) , strNewFileName  + [ ] + Transform( nFileSize /1024 /1024 ) + 'MB' , '异常信息：'   + m.ErrMsg   ) + Replicate( Chr(10) , 2 )

*--DownloadFile 下载一个文件
nHtTime          = Seconds()
strRemoteFileName= strNewFileName                     &&要下载的文件名
strFolder         = [C:\WebView2\testdata\download]  &&本地目录(不得以\结束)
strLocalFileName = strRemoteFileName                    &&保存在本地时的文件名
ErrMsg              = []                                &&错误信息
lReturn          = oFTP.DownloadFile ( strRemoteFileName , strFolder , strLocalFileName     , @ErrMsg )
?'DownloadFile 下载一个文件='  + NowstrDirName + [\] + strRemoteFileName   + ;
Iif( lReturn ,  '->成功,大小:' + Transform( nFileSize /1024 /1024 ) + 'MB' + ',耗时:'  + Transform( Seconds() - m.nHtTime )   ;
             ,  '异常信息：'   + m.ErrMsg   ) + Replicate( Chr(10) , 2 )

*--Delete 删除
strFileName      = strRemoteFileName    &&待删除文件名
ErrMsg           = []
lReturn       = oFTP.Delete( strFileName , @ErrMsg )
?'Delete删除文件='  + + Iif( lReturn , NowstrDirName + [\] + strNewFileName  , '异常信息：'+ ErrMsg    ) + Replicate( Chr(10) , 2 )


*--Dir 获得所有列表(目录与文件)(注意因FTP服务器不同列表格式是不一样的，这里取回来是原始列表，需要在VFP人工按格式要求转换)
      *该列表的格式将取决于ftp服务器的操作系统,你需要在VFP重新解析该格式
strMask  = []    &&文件名的匹配字符串
ErrMsg      = []    &&错误信息
Lists    = oFTP.Dir( strMask, @ErrMsg )
?'Dir获得所有列表=' + Chr(10) + Iif( Empty(ErrMsg ) ,  Lists , '异常信息：'      + ErrMsg     ) + Replicate( Chr(10) , 2 )

oFTP.DisConnect( @ErrMsg )
?'DisConnect关闭连接=' + Iif( Empty( ErrMsg ) , '成功' , '失败' )

#4

iswith2023-08-14 11:43

正在移植以下项目进VFP:
基础通信功能包含Tcp、Udp、Ssl、Rpc、Http等。其中http
服务器支持WebSocket、静态网页、XmlRpc、WebApi、JsonRpc
等扩展插件。和自定义协议的sock，支持Ssl加密、异步调用、
权限管理、错误状态返回、服务回调、分布式调用等。在空载函数
执行时，10万次调用仅3.8秒，在不返回状态时，仅0.9秒。增加它的并发性。

#5

pnyjq2023-08-14 15:52

好高级，很期待！

#6

sam_jiang2023-08-14 19:49

貌似很牛逼

#7

schtg2023-08-15 06:25

希望学习一下，谢谢！

#8

sych2023-08-15 09:34

回复 4楼 iswith

怎么收费？

#9

iswith2023-08-15 12:17

免费。。。。

#10

sam_jiang2023-08-15 19:43

下载码？

#11

iswith2023-08-15 21:40

https://down.bccn.net/12537.html

#12

schtg2023-08-16 05:33

谢谢！

#13

iswith2023-08-16 16:17

*--需要Netsuite.dll V1.003版支持
*--需要Mtcomvfp.dll
*--演示如何暂停，结束一个线程
Clear
_vfp.AutoYield = .F. &&消息列队( 在多线这样处理好一些,受窗体“X"影响 )

Local lcPath

If _vfp.StartMode = 0 Then
   m.lcPath = Justpath( _vfp.ActiveProject.Name  )
Else
   m.lcPath = Justpath( sys(16,0) )
Endif
Set Default To ( m.lcPath )

*--载入H文件
#INCLUDE Netsuite.H

*--载入一个线程完成/异常类|回调过程类
Set Procedure To mt_events.prg

*--创建一个VFP多线程函数( 或写好一个PRG 函数库直接调用）
Local lcthrprgtest ;
    , lcthrfuncfile

m.lcthrprgtest  = Addbs( Getenv("TEMP") ) + Sys(2015) + '.prg'
m.lcthrfuncfile    = Forceext( m.lcthrprgtest , 'fxp' ) &&线程执行的VFP过程函数*--创建线程函数

Text To m.lcthrFunction Textmerge noShow
    Function test ( cthrId ) && 线程ID号
             Do Win_Api
            *以下参数变量所有载入线程函数中可以访问:
*!*             cCmd                  As String ;&&执行的装载函数命令入参
*!*             , oThreadedAdapter    As Object ;&&线程适配器对象        入参
*!*             , oMainThread            As Object ;&&主线程对象            入参
*!*          , oThread              As Object ;&&当前线程对象        入参
*!*             , oThreadVFP          As Object ;&&入参-没有值经过MTComVFP附值线程VFP对象
*!*             , cRetuErrMsg            As String  &&出参-没有值经过MTComVFP线程函数执行结果返回值
             i = 1
             Do While ( .T.)
                 If oThreadedAdapter.isStop &&结束线程
                   Exit
                Endif
                *通过winAPI 给予线程交出CPU使用权,一般设计不会将CPU的使用全部由一个线程独占
*!*                    Sleep(500) &&大致意思为 500ms执行一次
                *--该处写线程处理一些事物
                *....
                 i = i + 1
             Enddo

             *--一定要有返回值
             Return Transform(i) + "OK"
    Endfunc

Endtext

strtofile( lcthrFunction , m.lcthrprgtest )
Compile ( m.lcthrprgtest )
Erase  ( m.lcthrprgtest )

*--实例化一个线程适配器对象[oThreadedAdapter]
Public oThreadedAdapter
m.oThreadedAdapter = Createobject("Netsuite.MultiThreadedAdapter")

*--绑定一个线程对象完成/异常事件(意思如果线程完成通知当前VFP主线程）
Local loComEvent
m.loComEvent = CREATEOBJECT("COMAdapterEvents")
If !EVENTHANDLER( m.oThreadedAdapter , m.loComEvent ) Then
    Messagebox('绑定一个线程事件类失败！',16, '绑定')
    Return .F.
Endif

Public othread
*--实例化一个线程对象[othread] MTA模式
othread                 = m.oThreadedAdapter.ThreadedAdapter( STA )
othread.IsBackground = .T.                                      &&后台线程
othread.Priority     = Normal                                &&优先级
othread.name         = 'test '                                 &&可以给这个线程命名一个名称
With m.oThreadedAdapter
    .ProgId   = [mtcomvfp.MultiThread]                         &&这个是用来关联VFP写的COM DLL类名
     *--将代码载入，且执行这个PRG的其中一个方法：
        *注意1.载入的PRG需要COMPILE为FXP(或执行一次系统默认编译）
        *注意2.prg被线程引用后注意修改,编译FXP，一般为等线程结束
        *注意3.prg的方法函数在执行需要返回前一定要加return
        *注意4."test_mtcomvfp_function.fxp"装载时需要注意路径位置
        *注意5.第一次的MTA多线程与后面的执行多线有所不同


     Text To m.lcCmd Textmerge Noshow Pretext 1+2+4
          set Procedure To <<m.lcthrfuncfile>> Additive
          Return test ("<<'线程'+Transform( othread.ManagedThreadId )>>" )
     Endtext
    .Cmd = m.lcCmd                                              &&放在C#多线适配器驱动成多线程
Endwith
?'线程'+ Transform( othread.ManagedThreadId )  + [执行:函数(] + othread.Name +') , 启动...'
othread.Start()

*-在需要的暂停，退出线程地方使用：
*!*    oThreadedAdapter.isStop = .T. &&结束线程
othread.Suspend         &&挂起线程
othread.Resume          &&恢复挂起线程
othread.Abort(.T.)        &&结束线程(与oThreadedAdapter.isStop不一样设计逻辑)

[此贴子已经被作者于2023-8-16 18:57编辑过]