*!* 驗證 email 信箱格式
lcExpression = "^([0-9a-zA-Z]+[-._+&])*[0-9a-zA-Z]+@([-0-9a-zA-Z]+[.])+[a-zA-Z]{2,6}$"
?RegExp("john@isp.com",lcExpression)
?RegExp("john@.isp.com",lcExpression)

*!* 驗證金額
lcExpression = "^(\$)?(([1-9]\d{0,2}(\,\d{3})*)|([1-9]\d*)|(0))(\.\d{2})?$"
?RegExp("$1,244,311.81",lcExpression) && Match
?RegExp("$1,24,4311.81",lcExpression) && No Match

*!* 驗證電話號碼
lcExpression = "^[2-9]\d{2}-\d{3}-\d{4}$"
?RegExp("507-562-0020",lcExpression) && Match
?RegExp("507-56-0020",lcExpression) && No Match

• A Regular Expressions library for Visual FoxPro
• Reg Exp - Visual FoxPro Wiki
• 一輩子受用的 Regular Expressions -- 兼談另類的電腦學習態度
• Programming with GNU Regex Library
• Jserv's blog: Regex Programming 資源
• Boost.Regex: Perl Regular Expression Syntax

Private Sub SysInfo1_DeviceArrival(ByVal DeviceType As Long, ByVal DeviceID As Long, ByVal DeviceName As String, ByVal DeviceData As Long)
Debug.Print "DeviceArrival"
Debug.Print "devicetype " & DeviceType
Debug.Print "DeviceID " & GetDrive(DeviceType, DeviceID)
Debug.Print "DeviceName " & DeviceName
Debug.Print "DeviceData " & DeviceData
End Sub

Private Function GetDrive(devType As Long, devID As Long) As String
Select Case devType
Case 0 To 1 ' returns null
GetDrive = devID
Exit Function
Case 3 To 4 ' returns null
GetDrive = devID
Exit Function
Case 2 ' logical drive.
' Create an array for the possible drive numbers returned by
' deviceID
Dim drives(25) ' A-Z
Dim dvNum As Long ' Possible bit values.
Dim i As Integer
dvNum = 1
drives(0) = 1
' Populate with bit values.
For i = 1 To 25
dvNum = dvNum * 2
drives(i) = dvNum
Next i
For i = 0 To 25
If drives(i) = devID Then
GetDrive = "Drive: " & Chr(i + 65)
Exit Function
End If
Next I
Case Else ' Other unexpected returns
Debug.Print devType, devID
End Select
End Function

* 主程式
LOCAL lc_sql
LOCAL lo_builder
lo_builder=CREATEOBJECT("csqlbuilder")
lo_builder.ADDCOLUMN("u_id")
lo_builder.ADDCOLUMN("u_name")
lo_builder.setTable("users")
lo_builder.addWhere("", "u_id", "=", "drury")
lo_builder.addOrderby( "u_id" )
lo_builder.addGroupby( "u_id" )
? "====="
? "select sql::"
?? lo_builder.getSelectSQL()
lo_builder.reconf()
lo_builder.addPair("u_id", "ellery")
lo_builder.addPair("u_name", "ellery")
lo_builder.setTable("users")
lo_builder.addWhere("", "u_id", "=", "drury")
? "====="
? "insert sql::" + lo_builder.getInsertSQL()
? "update sql::" + lo_builder.getUpdateSQL()
? "delete sql::" + lo_builder.getDeleteSQL()

*
* Builder pattern 類別實作
* 此類別適用環境: VFP 8.0
* 類別定義開始
*
DEFINE CLASS CSQLBuilder AS CUSTOM
  ADD OBJECT PROTECTED m_pairs AS COLLECTION
  ADD OBJECT PROTECTED m_where AS COLLECTION
  ADD OBJECT PROTECTED m_groupby AS COLLECTION
  ADD OBJECT PROTECTED m_orderby AS COLLECTION
  ADD OBJECT PROTECTED m_keys as collection
  m_table = "" && the table
  m_targettype="" && cursor, table
  m_target="" && name

  * Init
  PROCEDURE INIT
  ENDPROC

  * Destroy
  PROCEDURE DESTROY
  ENDPROC

  * Reconfigure
  PROCEDURE reconf
    * MSDN said: pass -1 will clear all items
    THIS.m_pairs.REMOVE( -1 )
    THIS.m_where.REMOVE( -1 )
    THIS.m_groupby.REMOVE( -1 )
    THIS.m_orderby.REMOVE( -1 )
    THIS.m_table = ""
    THIS.m_targettype=""
    THIS.m_target=""
  ENDPROC

  * addColumns
  PROCEDURE ADDCOLUMN( c_field AS STRING )
    THIS.m_pairs.ADD( .NULL., c_field )
  ENDPROC

  PROCEDURE addWhere( c_logical AS STRING, c_field AS STRING, c_operator AS STRING, o_value AS OBJECT )
    THIS.m_where.ADD( o_value, c_logical + c_field + c_operator )
  ENDPROC

  PROCEDURE addPair( c_field AS STRING, o_value AS OBJECT )
    THIS.m_pairs.ADD( o_value, c_field )
  ENDPROC

  PROCEDURE addGroupby( c_field AS STRING )
    THIS.m_groupby.ADD( .NULL., c_field )
  ENDPROC

  PROCEDURE addOrderby( c_field AS STRING )
    THIS.m_orderby.ADD( .NULL., c_field )
  ENDPROC

  PROCEDURE addKey( c_field as String )
    this.m_keys.add( .null., c_field )
  ENDPROC

  PROCEDURE addJoin
    * todo: this is the most hard part.
  ENDPROC

  PROCEDURE setTable( c_table AS STRING )
    THIS.m_table=c_table
  ENDPROC

  PROCEDURE setTarget( c_type AS STRING, c_target AS STRING )
    THIS.m_targettype=c_type
    THIS.m_target=c_string
  ENDPROC

  PROCEDURE getInsertSQL
    LOCAL i
    LOCAL lc_sql
    LOCAL lc_fields, lc_values, lc_type

    lc_fields=""
    lc_values=""
    lc_sql="insert into " + THIS.m_table + " "
    FOR i=1 TO THIS.m_pairs.COUNT
      lc_fields=lc_fields+THIS.m_pairs.GETKEY(i)
      IF( i+1 <= THIS.m_pairs.COUNT )
        lc_fields=lc_fields+","
      ENDIF
      lc_type=VARTYPE( THIS.m_pairs.ITEM(i) )
      DO CASE
        CASE lc_type="C"
          lc_values=lc_values+ "'" + THIS.m_pairs.ITEM(i)+ "'"
        CASE INLIST( lc_type, "N", "Y" )
          lc_values=lc_values + ALLTRIM( STR(THIS.m_pairs.ITEM(i) ) )
        CASE lc_type="D"
          lc_values=lc_values + "{^" + DTOC( THIS.m_pairs.ITEM(i) ) + "}"
        CASE lc_type="L"
          lc_values=lc_values + IIF( THIS.m_pairs.ITEM(i), ".T.", ".F." )
        CASE lc_type="X"
          lc_values=lc_values + ".null."
      ENDCASE
      IF( i+1 <= THIS.m_pairs.COUNT )
        lc_values=lc_values+","
      ENDIF
    NEXT
    lc_sql=lc_sql + "(" + lc_fields + ") values (" + lc_values + ")"
    RETURN lc_sql
  ENDPROC

  PROTECTED PROCEDURE getWhereSQL
    LOCAL lc_sql

    IF( THIS.m_where.COUNT >=1 )
      lc_sql=" where "
    ELSE
      lc_sql=""
    ENDIF
    FOR i=1 TO THIS.m_where.COUNT
      lc_type=VARTYPE( THIS.m_where.ITEM(i) )
      DO CASE
        CASE lc_type="C"
          lc_value= "'" + THIS.m_where.ITEM(i)+ "'"
        CASE INLIST( lc_type, "N", "Y" )
          lc_value= ALLTRIM( STR(THIS.m_where.ITEM(i) ) )
        CASE lc_type="D"
          lc_value="{" + DTOC( THIS.m_where.ITEM(i) ) + "}"
        CASE lc_type="L"
          lc_value=IIF( THIS.m_where.ITEM(i), ".T.", ".F." )
        CASE lc_type="X"
          lc_value=".null."
      ENDCASE
      lc_sql=lc_sql + THIS.m_where.GETKEY(i) + lc_value
      IF( i+1 <= THIS.m_where.COUNT )
        lc_sql=lc_sql+","
      ENDIF
    NEXT
    RETURN lc_sql
  ENDPROC

  PROCEDURE getOnlyKey( o_collection AS COLLECTION )
    LOCAL i
    LOCAL lc_sql

    lc_sql=""
    FOR i=1 TO o_collection.COUNT
      lc_sql=lc_sql+o_collection.GETKEY(i)
      IF( i+1 <= o_collection.COUNT )
        lc_sql=lc_sql+","
      ENDIF
    NEXT

    RETURN lc_sql
  ENDPROC

  PROCEDURE getOrderBySQL
    LOCAL lc_sql
    lc_sql=THIS.getOnlyKey( THIS.m_orderby )
    IF( EMPTY(lc_sql) )
      RETURN lc_sql
    ELSE
      RETURN " order by " + lc_sql
    ENDIF
  ENDPROC

  PROCEDURE getGroupbySQL
    LOCAL lc_sql
    lc_sql=THIS.getOnlyKey( THIS.m_groupby )
    IF( EMPTY(lc_sql) )
      RETURN lc_sql
    ELSE
      RETURN " group by " + lc_sql
    ENDIF
  ENDPROC

  PROCEDURE getSelectSQL
    LOCAL i
    LOCAL lc_sql, lc_where, lc_orderby, lc_groupby

    lc_sql="select "
    FOR i=1 TO THIS.m_pairs.COUNT
      lc_sql=lc_sql+THIS.m_pairs.GETKEY(i)
      IF( i+1 <= THIS.m_pairs.COUNT )
        lc_sql=lc_sql+","
      ENDIF
    NEXT
    lc_sql=lc_sql + " from " + THIS.m_table

    lc_where=THIS.getWhereSQL()
    lc_sql=lc_sql + lc_where

    lc_orderby=THIS.getOrderBySQL()
    lc_sql=lc_sql+lc_orderby

    lc_groupby=THIS.getGroupbySQL()
    lc_sql=lc_sql+lc_groupby

    RETURN lc_sql
  ENDPROC

  PROCEDURE getDeleteSQL
    LOCAL lc_sql
    LOCAL i
    LOCAL lc_value, lc_type, lc_where

    lc_sql="delete from " + THIS.m_table

    lc_where=THIS.getWhereSQL()
    lc_sql=lc_sql+lc_where

    RETURN lc_sql
  ENDPROC

  PROCEDURE getUpdateSQL
    LOCAL i
    LOCAL lc_sql
    LOCAL lc_fields, lc_values, lc_type, lc_where

    lc_fields=""
    lc_values=""
    lc_sql="update " + THIS.m_table + " set "
    FOR i=1 TO THIS.m_pairs.COUNT
      lc_sql=lc_sql+THIS.m_pairs.GETKEY(i)+"="
      lc_type=VARTYPE( THIS.m_pairs.ITEM(i) )
      DO CASE
        CASE lc_type="C"
          lc_sql=lc_sql + "'" + THIS.m_pairs.ITEM(i) + "'"
        CASE INLIST( lc_type, "N", "Y" )
          lc_sql=lc_sql + ALLTRIM( STR(THIS.m_pairs.ITEM(i) ) )
        CASE lc_type="D"
          lc_sql=lc_sql + "{^" + DTOC( THIS.m_pairs.ITEM(i) ) + "}"
        CASE lc_type="L"
          lc_values=lc_sql + IIF( THIS.m_pairs.ITEM(i), ".T.", ".F." )
        CASE lc_type="X"
          lc_values=lc_sql + ".null."
      ENDCASE
      IF( i+1 <= THIS.m_pairs.COUNT )
        lc_sql=lc_sql+","
      ENDIF
    NEXT

    * handle where clause.
    lc_where=THIS.getWhereSQL()
    lc_sql=lc_sql+lc_where

    RETURN lc_sql
  ENDPROC

  PROCEDURE getKeyFieldList()
    LOCAL i
    LOCAL lc_fields
    IF( THIS.m_keys.COUNT >=1 )
      lc_fields=""
    ELSE
      RETURN ""
    ENDIF
    FOR i=1 TO THIS.m_keys.COUNT
      lc_fields=lc_fields+this.m_keys.getKey(i)
      IF( i+1 <= THIS.m_keys.COUNT )
        lc_fields=lc_fields+","
      ENDIF
    NEXT
    RETURN lc_fields
  ENDPROC

  PROCEDURE getTable()
    RETURN THIS.m_table
  ENDPROC

  PROCEDURE getUpdatableFieldList()
    LOCAL i, lc_fields
    lc_fields=""
    FOR i=1 TO THIS.m_pairs.COUNT
      lc_fields=lc_fields+THIS.m_pairs.GETKEY(i)
      IF( i+1 <= THIS.m_pairs.COUNT )
        lc_fields=lc_fields+","
      ENDIF
    NEXT
    RETURN lc_fields
  ENDPROC

  PROCEDURE getUpdateNameList()
    LOCAL i, lc_fields
    lc_fields=""
    FOR i=1 TO THIS.m_pairs.COUNT
      lc_fields=lc_fields+THIS.m_pairs.GETKEY(i)+" "
      lc_fields=lc_fields+this.m_table+"."+this.m_pairs.getkey(i)
      IF( i+1 <= THIS.m_pairs.COUNT )
        lc_fields=lc_fields+","
      ENDIF
    NEXT
    RETURN lc_fields
  ENDPROC
ENDDEFINE
* 類別定義結束

DEFINE CLASS MyCalculator AS session OLEPUBLIC

Name = "MyCalculator"

PROCEDURE doAdd

                Parameters A , B

        Return A+B

ENDPROC

ENDDEFINE

obj=createobject(“MyWebService.MyCalculator”)

? obj.doAdd(100,100)

1. WSDL 產出的位置。


2. SOAP Listener型態。


3. IntelliSense的Script名稱。


4. 告訴VFP7在Project Build之後，是否自動產出相關的 Web Service 檔案。


5. 產出的WSDL檔案是否要以UTF-16 Unicode作為預設編碼。
   
   
   
   
   

x = CREATEOBJECT("MSSOAP.SoapClient")

x.MSSoapInit("http://ellery/webservices/MyCalculator.WSDL", , "MyCalculatorSoapPort")



=messagebox( str( x.doAdd( 100,100 ) ) )

…略…

  <message name='MyCalculator.doAdd'>

  </message>

  <message name='MyCalculator.doAddResponse'>

    <part name='Result' type='xsd:anyType'/>

  </message>

…略…

…略…

  <message name='MyCalculator.doAdd'>

    <part name='A' type='xsd:int'/>

    <part name='B' type='xsd:int'/>

  </message>



  <message name='MyCalculator.doAddResponse'>

    <part name='Result' type='xsd:anyType'/>

  </message>

…略…

PROCEDURE doAdd(A as Integer, B as Integer)

LOCAL obj

obj = CREATEOBJECT("MSSOAP.SoapClient")

obj.MSSoapInit("http://www.xmethods.net/sd/2001/TemperatureService.wsdl")

thisform.text2.value=obj.getTemp(thisform.text1.value)

DEFINE CLASS tastrade AS session OLEPUBLIC

Name = "tastrade"

PROCEDURE getAllEmployee()

        LOCAL handle as Integer 

        LOCAL lc_xml as String 



        handle=SQLSTRINGCONNECT("Driver=Microsoft Visual FoxPro Driver;” + ;

		“UID=;PWD=;” + ;

		“SourceDB=C:\WebService\Data\testdata.dbc;” + ;

		“SourceType=DBC;Exclusive=No;BackgroundFetch=Yes;” + ;

		“Collate=Machine;Null=Yes;Deleted=Yes;")

        =SQLEXEC(handle, ;

		"select emp_id, last_name, first_name, title from employee order by emp_id", ;

		"employees")

        =sqldisconnect(handle)

        CursorToXML("employees", "lc_xml")

        RETURN lc_xml

ENDPROC



PROCEDURE updateEmployee( c_request as string )

        LOCAL handle

        LOCAL o_xmlDom, o_nodelist1, o_nodelist2, o_nodeEmployee, o_node

        LOCAL strWhere as String , strSet as String , strSql as String 

        LOCAL ll_cycle as Boolean , ln_ret as Integer 



        c_request=STRTRAN( c_request, 'encoding="Windows-1252" ', "" )

        o_xmlDom=CreateObject("Microsoft.XMLDOM")

        o_xmlDom.async="false"

        o_xmlDom.loadXML(c_request)



        * parse xml and combine update-sql syntax

        IF o_xmlDom.hasChildNodes()

        ELSE

                RETURN

        ENDIF



        * create connection

        handle=SQLSTRINGCONNECT("Driver=Microsoft Visual FoxPro Driver;” + ;

	“UID=;PWD=;” + ;

	“SourceDB=C:\WebService\Data\testdata.dbc;” + ;

	“SourceType=DBC;Exclusive=No;BackgroundFetch=Yes;” + ;

	“Collate=Machine;Null=Yes;Deleted=Yes;")

        strWhere=""

        strSet=""

        l_cycle=.F.



        for each o_nodelist1 in o_xmlDom.documentElement.childNodes

                FOR EACH o_nodelist2 IN o_nodelist1.childNodes

                        * initialize variables

                        if o_nodelist2.nodeName="updg:before"

                                FOR EACH o_nodeEmployee IN o_nodelist2.childNodes

                                        FOR EACH o_node IN o_nodeEmployee.childNodes

                                                IF o_Node.nodeName="emp_id"

                                                        strWhere=strWhere+o_Node.nodeName+"="+"'" + ;

								TRANSFORM(o_Node.text,"@J 999999") + "' and "

                                                ELSE

                                                        strWhere=strWhere+o_Node.nodeName+"="+"'" + ;

								o_Node.text + "' and "

                                                ENDIF

                                        NEXT

                                NEXT

                        ENDIF

                        IF o_nodelist2.nodeName="updg:after"

                                IF NOT o_nodelist2.hasChildNodes()

                                ELSE

                                        FOR EACH o_nodeEmployee IN o_nodelist2.childNodes

                                                FOR EACH o_node IN o_nodeEmployee.childNodes

                                                        IF o_Node.nodeName="emp_id"

                                                        strSet=strSet+o_Node.nodeName+"="+"'" + ;

								TRANSFORM(o_Node.text,"@J 999999") + "',"

                                                        ELSE

                                                                strSet=strSet+o_Node.nodeName+"="+"'" + o_Node.text + "',"

                                                        ENDIF

                                                NEXT

                                        NEXT

                                ENDIF

                                l_cycle=.T.

                        ENDIF

                        IF l_cycle = .T.

                                * generate sql syntax

                                strWhere=LEFT(strWhere,LEN(strWhere)-4)

                                IF EMPTY(strSet)

                                        strSql="Delete from employee where "+ strWhere

                                ELSE

                                        strSet=LEFT(strSet,LEN(strSet)-1)

                                        strSql="Update employee set " + strSet + " where " + strWhere

                                ENDIF



                                * call sqlexec() to send update-sql

                                * and we can update our database

                                ln_ret=SQLEXEC(handle,strSql)

                                l_cycle=.F.

                                strWhere=""

                                strSet=""

                        ENDIF

                NEXT

        NEXT



        * disconnect    

        =sqldisconnect(handle)

ENDPROC

ENDDEFINE

LOCAL x as Object , lc_xml as String 



*因為在[Update]按鈕中的 xmlupdategram() 函數需要設製 buffermode 並將 multilocks 設為 True

SET MULTILOCKS ON 

IF USED("employee")

        thisform.grid1.RecordSource=""

        USE IN employee

ENDIF



x = CREATEOBJECT("MSSOAP.SoapClient")

x.MSSoapInit("http://ellery/webservice/tastrade.WSDL")

lc_xml=x.getAllEmployee( ) 

XMLToCursor(lc_xml,"employee")

thisform.grid1.RecordSource="employee"

thisform.Refresh()



SELECT employee

=CURSORSETPROP("buffering",5)

LOCAL lc_ret

LOCAL x, lc_xml



*檢查是否已經取得資料

IF NOT USED("employee")

        =MESSAGEBOX("[Retrieve] button not pressed!")

        RETURN

ENDIF



*產生異動的 xml

lc_ret=XMLUPDATEGRAM("employee")

IF EMPTY(lc_ret)    &&如果沒有異動,發出警告

        =MESSAGEBOX("You don't update any thing")

ENDIF

=MESSAGEBOX(lc_ret,"XMLUPDATEGRAM() generates following codes")



*將資料更新回去!

x = CREATEOBJECT("MSSOAP.SoapClient")

x.MSSoapInit("http://ellery/webservice/tastrade.WSDL")

x.updateEmployee( lc_ret )

SELECT employee

內容:

建置測試環境
測試
FetchAsNeeded??

點選這裡來下載本文章的範例程式

1.請先利用 sql server enterprise manager去建立一個 database,叫做demo
然後利用 Query Analyzer 執行以下的sql script
use demo
if exists (select * from sysobjects where id = objec