Category: Visual FoxPro

VFP 本身並不支援 Regular Expression，幸好，有人非常熱心，以 C/C++ 有名的 Boost library 為基礎，製作了給 VFP 用的 Regular Expression Library。
License 基本上是遵循 boost library 的 LGPL license，所以你可以直接使用 binary code (也就是 .fll)在商業用途上。
為甚麼要 Regular Expression？因為他可以很方便地以簡單的語法表示出一段文字的規則。
以文章裡面的範例來看，你會發現他真的好用～

*!* 驗證 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

幫朋友找資料找到的,順道貼上來
我沒試過
不過我想應該是可以運行吧~~
以 VFP 或 VB 來說,是利用 sysinfo 這個 Active X control .
主要是攔截 DeviceArrival 這個 event
詳細的範例可以參考DeviceArrival Event Example
雖然他是 VB 的範例,不過看起來應該是很好改成 VFP 才是…

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

以前逛到的兩個 Pattern, 比較特別的是:

1. Pattern 名字沒聽過,
2. 用 VFP 實作的~~

挺有趣的,網址在這裡:

• Hook operation
• Hooks and anchor

Hook operation 講的是一種包裝別人物件的方法,一般來說,都是利用繼承的方法來將對方的 control 包進去,然後再去作客製化的動作;這個 pattern 則是繼承以後,另外利用了一個 hook manager 去專門處理這個客製化的動作.所以才稱作 Hook(掛勾).
Hooks and anchar 則是前面 hook 的延伸,據我個人的理解,這就有點像是 c# 可以把很多 event 或 delegate 串起來一樣~不過我不是很確定啦~~
另外,上面文章所屬的網站還蠻多文章的,大部分是講如何用VFP去搞 Design Pattern 的,各位可以去看看~~
與各位分享~

給予適當的建構資料,就可以得到我們所需要的物件.
詳細的說明可以參考後面所附的參考資料,那些資料就已經寫的很好了,我想我沒必要再畫蛇添足.
最初製作 SQL Builder class 的時候是想說,我只要給予它一些欄位和條件,他就會自動幫我產生 SQL 敘述,而不必再去考量 SQL 敘述是否正確啊…等等的問題.剛好想到 Builder pattern 其實很適合,所以就實做看看.
目前這個 class 已經蠻齊全了,不過有些地方可以再加強.
1. Join 部分
2. 資料型態轉換,作的不好~應該可以再更精簡,更可靠.
3. 傳入 select – sql 敘述,就能產生 delete-sql, update-sql.
4. …
參考資料:
http://www.dotspace.idv.tw/Patterns/Jdon_Builder.htm
http://140.109.17.201/Jyemii/patternscolumn/articles/DesignPatternPart(2).htm
Design Pattern 中譯本 – 葉秉哲譯
範例程式:

* 主程式
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 =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 =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
* 類別定義結束

剛剛用 VFP8 在做 form 的時候
發現 TextBox 的 property 裡面居然有個以前沒看過的傢伙: FontCharSet
翻了一下 Help, 原來他可以指定 font 的 charset (字元集)
換言之,只要變動 Fontname, fontcharset, 與內容(value or caption), 應該就可以達到 localization (l10n)的目的了.

忘記從哪兒節錄下來的了,在這裡向作者說聲抱歉,因為那時沒有記下出處.
如果有侵犯版權的話,請來信告訴我,我會拿掉.
兩個 function 是作 base64 encode/decode 的.
不過, VFP7 以後,微軟已經擴充了 STRCONV() 的功能,讓他也能作 base64 encode/decode.
用法如下:
? STRCONV(“Hallo”,13) encodes to Base64
? STRCONV(“SGFsbG8=”,14) decodes from Base64
=====
FUNCTION Base64Encode(lcInput,loXML)
LOCAL loNode
IF VARTYPE(loXML) # “O”
loXML = CREATEOBJECT(“MSXML2.DOMDocument”)
loXML.Async = .F.
ENDIF
loXML.loadXML(“<node></node>”)
loNode = loXML.DocumentElement
loNode.dataType = “bin.base64”
loNode.nodeTypedValue = CREATEBINARY(lcInput)
RETURN loNode.Text
FUNCTION Base64Decode(lcInput,loXML)
LOCAL lcDocument
IF VARTYPE(loXML) # “O”
loXML = CREATEOBJECT(“MSXML2.DomDocument”)
loXML.Async = .F.
ENDIF
lcDocument = [<node xmlns:dt=”urn:schemas-microsoft-com:datatypes”
dt:dt=”bin.base64″>] + lcInput + [</node>]
loXML.loadXML(lcDocument)
RETURN loXML.DocumentElement.nodeTypedValue

Singleton,確保類別永遠只有一份實體
Singleton pattern, 簡言之,是一個確保類別永遠只有一份實體的範式(Pattern).
在什麼情況下,我們會用到這個 Pattern 呢??
比如,一台電腦裡在同一時間只能有一個視窗管理員在運行.
一般性的做法,是讓類別自行管理這個唯一個物件實體,讓他確保絕對無法生出第二個物件個體.
那麼在 VFP 裡面要如何實現呢??
讓我們來試試看,首先先定義出 CSingleton 這個Class
*
* Class Singleton
*
DEFINE CLASS CSingleton as Custom
  HIDDEN m_singleton
  m_singleton=.NULL.
  PROCEDURE getInstance
    IF m_singleton==.NULL.
      m_singleton=CREATEOBJECT(“CSingleton”)
    ENDIF
    RETURN m_singleton
  ENDPROC
  PROCEDURE getClassName
    return “I am Singleton Class”
  ENDPROC
ENDDEFINE
我們將 m_singleton 隱藏起來,讓外界無法直接存取,並且提供 getInstance method,讓外界可以透過此 method 取得 m_singleton 這個 instance.
所以當我們需要這個類別的實體時,就可以這麼寫:
lo_object=CSingleton::getInstance()
嘿,等等,別的語言是可以這麼寫,VFP 允許我們這樣用嗎??
此外,我們也沒有辦法隱喻地將 m_instance 放到 heap,像別的語言可以用 static 表明 m_instance 要放到 heap 中,確保只會有一份實體.
VFP 必須要先為 CSingleton 類別產生實體,才能呼叫 getInstance()
也就是要先這樣子
local lo_class, lo_object
lo_class=createobject(“CSingleton”)
lo_object=lo_class.getInstance()
才能讓 lo_object 取得實體.
那這不就違反我們的本意了嗎??
當使用者呼叫了多次 createobject(“CSingleton”), 等於是創建了好幾次 m_singleton,我們就無法讓 m_singleton 是系統中唯一的一個實體了.
那麼還有別的方法嗎??
嗯,用全域變數如何??
我們可以用全域變數搭配一個Function來使用.
所以就可以這麼寫
public m_instance
….
* 主程式
m_instance=.null.
…
* Function
function getInstance
  if m_instance==.null.
    m_instance=createobject(“CSingleton”)
  endif
  return m_instance
endfunc
…
* 要使用的時候
lo_object=getInstance()
? lo_object.getClassName()
…
這樣子總算是解決問題了,只要維持一個良好的撰寫習慣
就可以保證CSingleton的實體是唯一.
可是萬一後繼者不明白,直接去存取了全域變數 m_instance 的話,該怎麼辦呢??
嗯~~再換個方向來想
VFP 不是有個函數叫做 getobject() 嗎??
如果我們將類別轉為 OLEPUBLIC 之後,再使用 getobject() 去取得 instance,就可以取得唯一的實體來使用了.
這也不失為一個不錯的解法.
綜觀上面推論,或許還有其他的方法,是我沒有想到的.(我有想過用 fopen() 或 flock()…等等的)
但是就目前看來,在 VFP 裡面對 Singleton 並沒有一個完美的解法.
只有期待 VFP 未來能加入新的語言特性,讓我們能更靈活的運用了.
附錄: C++ 的解法
class CSingleton {
private:
  static CSingleton* m_instance;
protected: //保護起來,不讓 constructor 直接被叫用.
  Singleton();
  Singleton(const Singleton&);
  Singleton& operator= (const Singleton&);
public:
  CSingleton* getInstance(void) {
    if( m_instance==NULL )
      m_instance=new CSingleton();
    return m_instance;
  }
  char* getClassName(void) {
    return “Hello! Singleton Pattern!!\n”;
  }
}
CSingleton* CSingleton::m_instance=NULL; //因為宣告為 static,所以可以這樣給值.
int main( int argc, char* argv[] ) {
  CSingleton* obj=CSingleton::getInstance;
  printf( “%s”, obj->getClassName());
}

看完 RUN!PC 六月號由李維先生所寫的”由軟體品質檢驗談Design Pattern的應用”一文,我覺得用 VFP 就可以很簡單的作到,所以就以 VFP 實作.
該文以計算牌照稅為引子
計算牌照稅的時候,會需要依照汽缸的cc數以及私人/營業用車來判定收費的標準,照一般的寫法,很自然就會用到很多 If…Then…Else 或 do case…endcase, 可是這樣子程式碼就會變得很長很長,而難以維護.
像是這樣:
If cc < 500
  money=900
else
  if cc < 600
    money=1200
    &&….. 略
  endif
endif
用 do case 的話則是這樣
do case
  case between( 0, 500 )
    money=900
  case between( 501, 599 )
    money=1200
  && … 略
endcase
李先生以一個 Dispatcher pattern 解決此一問題.
在 VFP 裡面可以直接結合資料庫作更好的解法
*
* ITax.prg
*
DEFINE CLASS ITax as custom
  PROCEDURE Init()
    create cursor crTax( cc_lo I, cc_hi I, PrivateTax Y, BusinesTax Y )
    insert into crTax values ( 0, 500, $ 1620, $ 900 )
    insert into crTax values ( 501, 599, $ 2160, $ 1200 )
    insert into crTax values ( 600, 1199, $ 4320, $ 2160 )
    insert into crTax values ( 1200, 1799, $ 7120, $ 3060 )
    insert into crTax values ( 1800, 2399, $11230, $ 6480 )
    insert into crTax values ( 2400, 2999, $15210, $ 9900 )
    insert into crTax values ( 3000, 4199, $28220, $16380 )
    insert into crTax values ( 4200, 5399, $46170, $24300 )
    insert into crTax values ( 5400, 6599, $69690, $33660 )
    insert into crTax values ( 6600, 7799, $117000, $44460 )
    insert into crTax values ( 7800, 9999999, $117000, $44460 )
  ENDPROC
  PROCEDURE Destroy()
    use in crTax
  ENDPROC
  PROCEDURE GetTax( cc, theKind )
    local ly_result
    local lc_oldalias
    lc_oldalias=alias()
    select("crTax")
    go top
    locate for between( cc, crTax.cc_lo, crTax.cc_hi )
    if found()
      ly_result=crTax.&theKind
    else
      ly_result=0
    endif
    select( lc_oldalias )
    return ly_result
  ENDPROC
  PROCEDURE GetPrivateTax( cc )
    return this.GetTax( cc, "PrivateTax" )
  ENDPROC
  PROCEDURE GetBusinessTax( cc )
    return this.GetTax( cc, "BusinesTax" )
  ENDPROC
ENDDEFINE
*
* test_itax.prg
*
LOCAL lo_obj
set procedure to itax.prg
lo_obj=createobject("ITax")
? lo_obj.GetPrivateTax( 1000 )
? lo_obj.GetBusinessTax( 2000 )
瞧,這樣不是簡單多了嗎??
在這裡拋磚引玉一下,希望大家如果有更好的解法
也 post 上來,讓大家觀摩一下
^_^