[野人獻曝]自己寫的 Function(找字串)

[劍痞憶秋年]

' 目的：找出 參數1 中 ((1)第 參數3 次 or (2) 參數4 之後) 參數2 出現的位置
補強 instr 只能定點找，而不能依第幾個找!!
' 用法：
(1)JetCountStrInstrTimesLocate("abcdefggfedcba","a",2)
找出 第 2 個 "a" 出現的位置
(2)JetCountStrInstrTimesLocate("abcdefggfedcba","b",0,5)
找出第 6 碼後的 第一個 b 出現的位置

Public Function JetCountStrInstrTimesLocate%(ByVal JetSource$, ByVal JetFindStr$, Optional ByVal JetTimes%, Optional ByVal JetTempInstr%, Optional ByVal JetTrue_UCASE As Boolean)

' 目的：找出 參數1 中 ((1)第 參數3 次 or (2) 參數4 之後) 參數2 出現的位置
' =============================================================================
' 參數一 (JetSource$) ：待找的大目標
' 參數二 (JetFindStr$) ：待找的小目標
' -----------------------------------------------------------------------------
' 【(2)非必要參數】
' 參數三 (JetTimes%) ：以 參數三 次 ==> 來判斷
' 參數四 (JetTempInstr%)：省略掉 前參數四個字元
' (◎當 參數三 = 0 才會有效)
' 參數五 (JetTrue_UCASE)：(是否) 分大小寫
' =============================================================================

Dim JetFound%, JJJ%

' (1)第 參數三 次
If JetTempInstr% = 0 Then
If JetTimes = 0 Then JetTimes = 1
If Not JetTrue_UCASE Then
JetFound = InStr(UCase(JetSource$), UCase(JetFindStr$))
Else
JetFound = InStr(JetSource$, JetFindStr$)
End If
Do While (JetFound <> 0) And (JJJ + 1 <> JetTimes)
JJJ = JJJ + 1
If Not JetTrue_UCASE Then
JetFound = InStr(JetFound + Len(JetFindStr$), UCase$(JetSource$), UCase$(JetFindStr$))
Else
JetFound = InStr(JetFound + Len(JetFindStr$), JetSource$, JetFindStr$)
End If
Loop
' (2)參數四 之後
Else
If Not JetTrue_UCASE Then
JetFound = InStr(JetTempInstr% + 1, UCase$(JetSource$), UCase$(JetFindStr$))
Else
JetFound = InStr(JetTempInstr% + 1, JetSource$, JetFindStr$)
End If
' (2005-0622新增)混合兩種參數方式
' ○還不是很確定這部份程式運作 (是否) 沒問題?!
Select Case JetTimes
Case 0, 1
Case Else
Do While (JetFound <> 0) And (JJJ + 1 <> JetTimes)
JJJ = JJJ + 1
If Not JetTrue_UCASE Then
JetFound = InStr(JetFound + Len(JetFindStr$), UCase$(JetSource$), UCase$(JetFindStr$))
Else
JetFound = InStr(JetFound + Len(JetFindStr$), JetSource$, JetFindStr$)
End If
Loop
End Select
End If

JetCountStrInstrTimesLocate = JetFound

End Function

[mini]

個人也對字串運用下過一份苦心
不錯用的說

比如
strTemp=StringSplit_Str("c:\abc\temp\test.txt", "1\0$\", 0)
結果strTemp="test.txt"，將後面的 0 改成 1 就變成 "c:\abc\temp\"

strTemp=StringSplit_Str("test.txt", "1\0$.", 0)
則可得副檔名 strTemp="txt"

strTemp=StringSplit_Str("test.exe 11,22,33", ",", 2)
則strTemp= "22"，改成 3 則是 "33"

strText="a,b,c,d,e"
strTemp=StringSplit_Str(strText, ",", 0)
strTemp=StringSplit_Str(strText, ",")
strTemp=StringSplit_Str(strText, ",")
strTemp=StringSplit_Str(strText, ",")
strTemp=StringSplit_Str(strText, ",")
則strTemp依序得到 "a" "b" "c" "d" "e"

涵式如下
===============

Public Function StringSplit_Str(ByVal TextTemp, ByVal NOStringIs, Optional ByVal StartNO As Long)
Dim CharNO As Long
Static no As Long

If Mid$(NOStringIs, 1, 3) = "1\0" Then GoTo AgainstSearchLABLE

If StartNO = 0 Then
no = no + 1
StartNO = Abs(no)
ElseIf StartNO > 0 Then
no = 0
End If

If TextTemp = "" Then Exit Function
Do
StartNO = StartNO - 1
CharNO = InStr(1, TextTemp, NOStringIs, vbBinaryCompare)

If CharNO > 1 Then
StringSplit_Str = Mid$(TextTemp, 1, CharNO - 1)
ElseIf CharNO = 0 Then
StringSplit_Str = TextTemp
ElseIf CharNO = 1 Then
StringSplit_Str = ""
End If
TextTemp = Mid$(TextTemp, CharNO + Len(NOStringIs)) 'trim
If CharNO = 0 And StartNO <> 0 Then
StringSplit_Str = ""
Exit Function
End If
Loop Until StartNO = 0
Exit Function

AgainstSearchLABLE:
'逆搜尋字串 NOStringIs
If TextTemp = "" Then Exit Function
no = Len(TextTemp)

NOStringIs = Mid$(NOStringIs, 5)
CharNO = InStrRev(TextTemp, NOStringIs, no, vbBinaryCompare)
CharNO = CharNO - 1

If StartNO = 1 Then '路徑
StringSplit_Str = Mid$(TextTemp, 1, CharNO + Len(NOStringIs))
ElseIf StartNO = 0 Then '檔名
StringSplit_Str = Mid$(TextTemp, CharNO + Len(NOStringIs) + 1)
End If

End Function

[mini]

^^
個人的例子再示範一個
LEND$ = ChrW$(13) & ChrW$(10)
strText= _
"第一行" +LEND+ _
"第二行" +LEND+ _
"第三行"

do
strTemp=StringSplit_Str(strText, LEND)
ListBox.Additem strTemp
loop until strTemp=""

以上例子是將每行加入到 ListBox每行

[劍痞憶秋年]

作者: mini

個人也對字串運用下過一份苦心
不錯用的說

比如
strTemp=StringSplit_Str("c:\abc\temp\test.txt", "1\0$\", 0)

<1>
謝謝版主的分享！！
這個 Function 的感覺有點像 Split 的進階功能
(個人感覺是很像不用 陣列企接收 的 split，而且還直接取出想要的部份)

可以給劣者拿來用嗎？！
小弟收下來研究一下∼∼
雖然程式碼蠻精簡的，不過看範例，發現 可以拿來應用的範圍 還真不少，
((1)取得路徑、檔名
(2)分離參數 ......)

(PS：不過可否請教一下
<1>Static no As Long
小弟發現這行的宣告會造成一個很不確定的變數，
拿您的範例使用之後，分別使用的時候，是 OK 的
但是當 聯合使用時，下列的[範例1]、[範例2]會受影響
因為 no 一直在累加！！
EX:

作者: mini

^^
[範例1]
strText="a,b,c,d,e"
strTemp=StringSplit_Str(strText, ",", 0)
strTemp=StringSplit_Str(strText, ",")
strTemp=StringSplit_Str(strText, ",")
strTemp=StringSplit_Str(strText, ",")
strTemp=StringSplit_Str(strText, ",")
則strTemp依序得到 "a" "b" "c" "d" "e"

[範例2]
LEND$ = ChrW$(13) & ChrW$(10)
strText= _
"第一行" +LEND+ _
"第二行" +LEND+ _
"第三行"

do
strTemp=StringSplit_Str(strText, LEND)
ListBox.Additem strTemp
loop until strTemp=""

（1）當範例 1 Run 過一次時，(範例1結果ok)再 Run 範例 2(範例2結果not ok)
（2）當範例 2 Run 過一次時，(範例2結果ok)再 Run 範例 1(範例1結果not ok)
（3）當範例 1 Run 兩次時，第一次 結果ok ，第二次結果not ok)
（4）當範例 2 Run 兩次時，第一次 結果ok ，第二次結果not ok)
(5) 上述的執行都是在 Restart 程式之後才是如此，若是一直 Keep 混合交叉 Run 的話，那只會有最初的第一次結果是對的!!!
(偶初步的認知是這個 no 為了找下一個字串而設的！
也知道了 StartNO > 0 會把它做一個清除)
但是總是覺得有點......，
同樣的程式碼，但是造成了兩次的執行結果不同，
　　　 那是不是要變成要很注意 no 的變化

不曉得是小弟不懂得使用還是....
若是說的不對的話，請 版主 不吝批評指正
(畢竟小弟雖然不是初學，但是都是看書來的，觀念並不是那麼正確)
<2>1\0 這樣的寫法，是怎麼的由來，
好像是 C or Pascal 的寫法，是不是依那個的靈感來寫的咧!!!
(好像啦，小弟很久沒碰過了))

<2>
If TextTemp = "" Then Exit Function

這個出現了兩次(分別出現在正、逆搜尋)
這句應該可以移到 變數宣告完後的 第一行，
兩行可以變成 一行，可以省了一行程式碼∼∼
(小弟個人的看法啦！！)

[mini]

^^ 劍痞憶秋年 可以隨意用
貼出來就是不打算自己用的

至於If TextTemp = "" Then Exit Function
也可以已那麼做 ^^||
如果不那麼做 可以當作跳過一次

1\0 這樣的寫法
只是自己認為比較好分辨的說 (1 代表開頭 0 代表結尾，與 C or Pascal 無關^^||)

這個涵式是一年前寫的
當時算是第一次寫複雜的專案
其後只修改過一次
所以有問題也不是沒可能的

至於 no 的問題...
原則上
ByVal TextTemp, ByVal NOStringIs, Optional ByVal StartNO As Long
三個參數
幾乎都要填寫的
如此用起來都沒問題
第三個參數(不填寫) 應用在 連續取值
如有疑慮
可以自行修改涵式

最近在規劃一個 4星彩 的程式
也有用到這個涵式(自己的近10個專案百分之8 9 10都有用到)
如果 憶秋兄 改出心得的話
也請不吝指教的說 ^^

(對了 憶秋兄 之前的兩篇不知為何自與刪除了 ??)

Public Function StringSplit_Str(ByVal TextTemp, ByVal NOStringIs, Optional ByVal StartNO As Long)
Dim CharNO As Long
Static no As Long

If TextTemp = "" Then Exit Function
If Mid$(NOStringIs, 1, 3) = "1\0" Then GoTo AgainstSearchLABLE

If StartNO = 0 Then
no = no + 1
StartNO = Abs(no)
ElseIf StartNO > 0 Then
no = 0
End If

Do
StartNO = StartNO - 1
CharNO = InStr(1, TextTemp, NOStringIs, vbBinaryCompare)

If CharNO > 1 Then
StringSplit_Str = Mid$(TextTemp, 1, CharNO - 1)
ElseIf CharNO = 0 Then
StringSplit_Str = TextTemp
ElseIf CharNO = 1 Then
StringSplit_Str = ""
End If
TextTemp = Mid$(TextTemp, CharNO + Len(NOStringIs)) 'trim
If CharNO = 0 And StartNO <> 0 Then
StringSplit_Str = ""
Exit Function
End If
Loop Until StartNO = 0
Exit Function

AgainstSearchLABLE:
'逆搜尋字串 NOStringIs
no = Len(TextTemp)

NOStringIs = Mid$(NOStringIs, 5)
CharNO = InStrRev(TextTemp, NOStringIs, no, vbBinaryCompare)
CharNO = CharNO - 1

If StartNO = 1 Then '路徑
StringSplit_Str = Mid$(TextTemp, 1, CharNO + Len(NOStringIs))
ElseIf StartNO = 0 Then '檔名
StringSplit_Str = Mid$(TextTemp, CharNO + Len(NOStringIs) + 1)
End If

End Function

[mini]

最後一個範例 <字串替換>

LEND$ = ChrW$(13) & ChrW$(10)
strText= _
"第一行" +LEND+ _
"第二行" +LEND+ _
"第三行"

要將 "第二行" 換成 "second line"

strText = _
StringSplit_Str(strText, LEND, 1) + LEND + _
"second line" + LEND + _
StringSplit_Str(strText, LEND, 3)

(或許效能不是很好，但以現在的 PC來說，還是小case)
變成

strText=
"第一行"
"second line"
"第三行"

以上只是 三行的示範
大於的話 就不是這麼單純了
網友們可以自己想想

[劍痞憶秋年]

作者: mini

^^ 劍痞憶秋年 可以隨意用
(對了 憶秋兄 之前的兩篇不知為何自與刪除了 ??)

唉呀!!!拍寫啦,有點小佔版面~~~
可能會讓 人 失焦的感覺~~~所以就把它刪除了!!!!
(之後再把它各開一個主題好了~~~ㄟ！會不會有灌水的嫌疑啊!!!呵~~~ )

版主這麼解釋，小弟就了解了~~~~
那小弟把它略為修改一下~~~~再 Post 上來 給 版主 及 其它人 看看!!
(可能只是改成小弟覺得個人習慣的寫法啦，畢竟程式沒有什麼優劣，都是設計者的　idea 及 習慣而己!!!!)

作者: mini

最後一個範例 <字串替換>

真是有一套，其中還有字串替換的功能，功能真廣泛
先把它抄下來，然後再研究一下!!

[劍痞憶秋年]

作者: mini

最後一個範例 <字串替換>
LEND$ = ChrW$(13) & ChrW$(10)

請教一下，這個 ChrW$(13) & ChrW$(10)
從沒看過 ChrW$ 這個 VB Function
用途是什麼
那這個 ChrW$(13) & ChrW$(10) 和 vbCrlf (應該是 = Chr(13) & Chr(10) )有差別嗎?

[mini]

沒差別 vbNewLine = vbCrlf = ChrW$(13) & ChrW$(10) = Chr(13) & Chr(10)

ChrW 函數傳回一個包含Unicode 字元的String，若在不支援Unicode的平台上，其功能與Chr函數相同。

但可以用來判斷 Unicode 檔案
0D 00 0A 00 = LEND

[劍痞憶秋年]

整個重新改寫(大幅依賴 VB 的 Split)
(用別人的想法來 改寫 對偶還真是不那麼容易！！)

(對了，版主您原先寫的參數
ByVal TextTemp, ByVal NOStringIs
==> 應該可以改成 ByVal TextTemp AS String, ByVal NOStringIs as string)
(ㄟ，不宣告會變成 Variant 型別，會比較佔記憶體，小弟怕怕！！ )

不過小弟
(1)把 您 原先第三個參數傳入 0 的部份 全部都改成 + 1
(與事實一致 (EX:第 1 個，而不會有第 0 個)，而不採 以 0 為底的 算法)
(若是傳入0 OR 根本沒傳值的話，預設為1)
(2)至於 最後一個置換的範例 ，小弟倒是加強了
(1)現在 應該是沒限制
(2)直接就可以傳回全部的字串，不用再由 程式設計師 組合了
(3)取消了 連續取的模式(找下一個)
(4)增加了許多參數(還沒仔細試每一種組合的結果，是否會影響 結果，至少目前還沒測到問題)
(PS ：
(1)其中 參數五 算是最特殊的 模式，只有自己的功效，目前無法混合其它參數的功效，且優先順序 > 其它 參數 )
(2) 參數七 目前還沒有實質作用 (因為要改到可用有點複雜)
參數七 的用意是為了 若是 參數二 的內容若含英文字，是否完全符合大小寫才算一致)
(5)突然想到
　因為 是 (大幅依賴 VB 的 Split) ，若是這個 Functoin 要在沒有 Split Function 的程式語言 中 改寫的話， 那就


範例：
? JetGetStr_Split("c:\abc\temp\test.txt", "\",1 , , ,True )
test.txt
? JetGetStr_Split("c:\abc\temp\test.txt", "\",2 , ,,True )
c:\abc\temp\

? JetGetStr_Split("test.txt", ".", 1,,,True )
txt

? JetGetStr_Split("test.exe 11,22,33", ",", 1)
test.exe 11
? JetGetStr_Split("test.exe 11,22,33", ",", 2)
22
? JetGetStr_Split("test.exe 11,22,33", ",", 3)
33

'strText = "a,b,c,d,e"
'strTemp = StringSplit_Str(strText, ",", 0)
'strTemp = StringSplit_Str(strText, ",")
'strTemp = StringSplit_Str(strText, ",")
'strTemp = StringSplit_Str(strText, ",")
'strTemp = StringSplit_Str(strText, ",")
'則strTemp依序得到 "a" "b" "c" "d" "e"

? JetGetStr_Split("a,b,c,d,e", ",", 1)
? JetGetStr_Split("a,b,c,d,e", ",", 2)
? JetGetStr_Split("a,b,c,d,e", ",", 3)
? JetGetStr_Split("a,b,c,d,e", ",", 4)
? JetGetStr_Split("a,b,c,d,e", ",", 5)
分別可得到 "a" , "b" ,"c" ,"d" ,"e"
不過沒有喪失了那種找下一筆的功能就是了

II = 1
Do
strTemp = JetGetStr_Split(strText, LEND, II)
ListBox1.AddItem strTemp
II = II + 1
Loop Until strTemp = ""

<字串替換>
? JetGetStr_Split("第一行" + LEND + "第二行" + LEND + "第三行", LEND$,2,"second line")
第一行
second line
第三行


Public Function JetGetStr_Split(ByVal JetSource$, Optional ByVal JetStr_Start As String, Optional ByVal JetTimes As Integer, Optional ByVal JetStr_Insert$, Optional ByVal JetTrue_Rev As Boolean, Optional ByVal JetTrue_JustTwo As Boolean, Optional ByVal JetTrue_UCASE As Boolean) As String

' 目的：(1)取得 參數一 字串 中 (正倒數==>參數五) 第 參數三-1 個 參數二 ∼ 第 參數三 個 參數二 中間的字串
' (2)取代 參數一 字串 中 (正倒數==>參數五) 第 參數三-1 個 參數二 ∼ 第 參數三 個 參數二 中間的字串 ==> 用 參數四 取代
' (3)JetTrue_JustTwo 模式 ==> 把 參數一 字串 依 參數二 拆成兩部份
'
' ==========================================================================================================
' 參數一(JetSource$) ：待處理的完整字串
' ==========================================================================================================
'【(2)非必要參數】
' 參數二(JetStr_Start) ：起始字串
' 參數三(JetTimes) ：第 幾 個
' 參數四(JetStr_Insert$) ：取代字串 + 啟動 取代模式
' 參數五(JetTrue_Rev) ：(是否) 要從倒數
' 參數六(JetTrue_JustTwo)：(是否) 採 (二分法) (目錄、檔案名稱特殊分離法)
' 參數七(JetTrue_UCASE) ：(是否) 分大小寫
' ==========================================================================================================

Dim JetTemp() As String, II As Integer, JJ As Integer
Dim JetTwo(1 To 2) As String
Dim intK As Integer

If JetSource$ = "" Then Exit Function

If Not JetTrue_UCASE Then
intK = InStr(UCase(JetSource), UCase(JetStr_Start))
Else
intK = InStr(JetSource, JetStr_Start)
End If
If intK = 0 Then Exit Function

If JetTimes = 0 Then JetTimes = 1

If Not JetTrue_JustTwo Then
' If Not JetTrue_UCASE Then
' JetTemp() = Split(UCase(JetSource$), UCase(JetStr_Start))
' Else
JetTemp() = Split(JetSource$, JetStr_Start)
' End If

If Not JetTrue_Rev Then
JJ = JetTimes - 1
Else
JJ = UBound(JetTemp) - JetTimes + 1
End If

If JetTimes > UBound(JetTemp) + 1 Then
JetGetStr_Split = ""
Exit Function
' 分解模式
ElseIf JetStr_Insert$ = "" Then
JetGetStr_Split = JetTemp(JJ)
' 取代模式
Else
For II = LBound(JetTemp) To UBound(JetTemp)
Select Case II
Case JJ
JetGetStr_Split = JetGetStr_Split & JetStr_Insert$ & JetStr_Start
Case UBound(JetTemp)
JetGetStr_Split = JetGetStr_Split & JetTemp(II)
Case Else
JetGetStr_Split = JetGetStr_Split & JetTemp(II) & JetStr_Start
End Select
Next II
End If
Else
If Not JetTrue_UCASE Then
intK = InStrRev(UCase(JetSource), UCase(JetStr_Start))
Else
intK = InStrRev(JetSource, JetStr_Start)
End If
JJ = 1
JetTwo(JJ) = Mid(JetSource, intK + 1)
JetTwo(JJ + 1) = Left(JetSource, intK)
If JetTimes <= JJ + 1 Then
JetGetStr_Split = JetTwo(JetTimes)
End If
End If

End Function

[劍痞憶秋年]

作者: mini

沒差別 vbNewLine = vbCrlf = ChrW$(13) & ChrW$(10) = Chr(13) & Chr(10)

ChrW 函數傳回一個包含Unicode 字元的String，若在不支援Unicode的平台上，其功能與Chr函數相同。

但可以用來判斷 Unicode 檔案
0D 00 0A 00 = LEND

了解，受教了∼∼∼以後都改用 ChrW$(13) & ChrW$(10)

作者: mini

最近在規劃一個 4星彩 的程式

有沒有算明牌 or 穩中 or 讓機率變高 的啊，這樣賺比較快說，寫程式挺花腦筋的咧！！
其實花腦筋還是其次啦，最主要想寫一些自己真的想做的，而不是被逼著做的!!!
（寫的心情差蠻多的）

[mini]

作者: 劍痞憶秋年

了解，受教了∼∼∼以後都改用 ChrW$(13) & ChrW$(10)


有沒有算明牌 or 穩中 or 讓機率變高 的啊，這樣賺比較快說，寫程式挺花腦筋的咧！！
其實花腦筋還是其次啦，最主要想寫一些自己真的想做的，而不是被逼著做的!!!
（寫的心情差蠻多的）

^^
因為如此 所以會比較少來論壇

使用視覺化設計及運算 之觀念
考慮因素有

號碼球(0~9) :
開出次數
阻力
方向
碰撞
增益值 0.xxx

出球間隔時間
反應時間

[劍痞憶秋年]

Public Function JetCountStrInstrTimesLocateRev%(ByVal JetSource$, ByVal JetFindStr$, Optional ByVal JetTimes%, Optional ByVal JetTempInstr%, Optional ByVal JetTrue_UCASE As Boolean)

' 目的：找出 參數1 中 “倒數” ((1)第 參數3 次 or (2) 參數4 之後) 參數2 出現的位置
'
' 參照：
' 【Module】
' (1) 本 Module 中的 JetGetStr_Replace$
'
' =============================================================================
' 參數一(JetSource$) ：待找的大目標
' 參數二(JetFindStr$) ：待找的小目標
' -----------------------------------------------------------------------------
' 【(2)非必要參數】
' 參數三(JetTimes%) ：以 參數三 次 ==> 來判斷
' 參數四(JetTempInstr%)：省略掉 前參數四個字元
' (◎當 參數三 = 0 才會有效)
' 參數五(JetTrue_UCASE)：(是否) 分大小寫
' =============================================================================

Dim JetFound%, JJJ%
Dim JetSource_Temp$

JetSource_Temp$ = JetSource$

If Not JetTrue_UCASE Then
' ◎因為 不分大小寫，所以 先把 關鍵字的部份 JetFindStr$ 改成一致 (全大寫)
JetSource$ = JetGetStr_Replace$(JetSource$, JetFindStr$, UCase(JetFindStr$), , True)
End If

' (1)第 參數三 次
If JetTempInstr% = 0 Then
If JetTimes = 0 Then JetTimes = 1
If Not JetTrue_UCASE Then
JetFound = InStrRev(JetSource$, UCase(JetFindStr$))
Else
JetFound = InStrRev(JetSource$, JetFindStr$)
End If
Do While (JetFound <> 0) And (JJJ + 1 <> JetTimes)
JJJ = JJJ + 1
JetSource$ = Left(JetSource$, JetFound - 1)
If Not JetTrue_UCASE Then
JetFound = InStrRev(JetSource$, UCase$(JetFindStr$))
Else
JetFound = InStrRev(JetSource$, JetFindStr$)
End If
Loop
' (2)參數四 之後
Else
JetSource$ = Mid(JetSource, JetTempInstr% + 1)
If Not JetTrue_UCASE Then
JetFound = InStrRev(JetSource$, UCase$(JetFindStr$))
Else
JetFound = InStrRev(JetSource$, JetFindStr$)
End If
Select Case JetTimes
Case 0, 1
Case Else
Do While (JetFound <> 0) And (JJJ + 1 <> JetTimes)
JJJ = JJJ + 1
JetSource$ = Left(JetSource$, JetFound - 1)
If Not JetTrue_UCASE Then
JetFound = InStrRev(JetSource$, UCase$(JetFindStr$))
Else
JetFound = InStrRev(JetSource$, JetFindStr$)
End If
Loop
End Select
End If

JetCountStrInstrTimesLocateRev = JetFound

End Function

[劍痞憶秋年]

Public Function JetGetFile_MainName$(ByVal JetTemp_FileName$)

' 目的：取得檔案主檔名(藉由分離 主檔名 及 副檔名)
'
' ●部份功能 ＝ fs.GetBaseName(JetTemp_FileName$)
'
' 參照：
' 【Module】
' (1) 本 Module 中的 JetCheckFileName、JetGetFileName
'
' =============================================================================
' 參數一(JetTemp_FileName$)：〔路徑 ＋ 〕 主檔名 〔 ＋ 副檔名〕
' =============================================================================

' 只留下檔名
' (1)先扣除 路徑(若有的話)
If InStrRev(JetTemp_FileName$, "\") <> 0 Then JetTemp_FileName = JetGetFileName$(JetTemp_FileName)

' (2)再扣除 副檔名(若有的話)
If InStrRev(JetTemp_FileName$, ".") <> 0 Then
JetGetFile_MainName$ = Left(JetTemp_FileName$, InStrRev(JetTemp_FileName$, ".") - 1)
Else
JetGetFile_MainName$ = JetTemp_FileName$
End If

' ◎過瀘掉含有不正當的命名(檔案)
If Not JetCheckFileName(JetGetFile_MainName$) Then
MsgBox "一、『" & JetGetFile_MainName$ & "』 主檔名可能有誤！" & vbCrLf & " 其中含有不合法的字元" & vbCrLf & vbCrLf & " 導致傳入 JetCheckFileName 的結果是 False！！！" & vbCrLf & vbCrLf & "二、 JetCheckFileName Module 中判斷有誤！", vbCritical, "From 『JetGetFile_MainName$』"
JetGetFile_MainName$ = ""
End If
End Function

Public Function JetGetFile_SubName$(ByVal JetTemp_FileName$, Optional ByVal JetTrue_Mustbe_SubName As Boolean, Optional ByVal JetTrue_GetDot As Boolean)

' 目的：取得檔案副檔名(藉由分離 主檔名 及 副檔名)
'
' ●部份功能 ＝ fs.GetExtensionName(JetTemp_FileName$)
'
' 參照：
' 【Module】
' (1) 本 Module 中的 JetCheckFileName、JetGetFileName
'
' =============================================================================
' 參數一(JetTemp_FileName$)：〔路徑 ＋ 〕〔 主檔名 ＋ 〕 副檔名(含前面的 ".")
' -----------------------------------------------------------------------------
' 【(2)非必要參數】
' 參數二(JetTrue_Mustbe_SubName)：(是否) 可以傳入不含 "." ==> 但仍要判定為 副檔名
' ◎目前偶只能借助 "." 來取得副檔名的實際內容
' 所以當 此參數為 True 時，一定是確定 傳入的參數一的值內 一定 含副檔名
' (1) 含 "."
' (2)不含 "." ==> 就是被扣除"." or 原來就指定成 不含"."的副檔名 的參數
' 針對 上一行介紹的 (2) 的情況時比較 OK
' EX:把 "MDB" 傳入本 Function ==> 傳出結果 將會是 ""
' 而若是此 參數改設成 True，則還是能得到 "MDB"
' 參數三(JetTrue_GetDot) ：(是否) 含"."
' =============================================================================

Dim III%

' 只留下檔名
If InStrRev(JetTemp_FileName$, "\") <> 0 Then JetTemp_FileName = JetGetFileName$(JetTemp_FileName)

If JetTrue_GetDot Then III = 1

If InStrRev(JetTemp_FileName$, ".") <> 0 Then
JetGetFile_SubName$ = Mid(JetTemp_FileName$, InStrRev(JetTemp_FileName$, ".") + 1 - III)
' ◎過瀘掉含有不正當的命名(檔案)
If Not JetCheckFileName(JetGetFile_SubName$) Then
MsgBox "一、『" & JetGetFile_SubName$ & "』 副檔名可能有誤！" & vbCrLf & " 其中含有不合法的字元" & vbCrLf & vbCrLf & " 導致傳入 JetCheckFileName 的結果是 False！！！" & vbCrLf & vbCrLf & "二、 JetCheckFileName Module 中判斷有誤！", vbCritical, "From 『JetGetFile_SubName$』"
JetGetFile_SubName$ = ""
End If
Else
' 若 傳入的沒有 "." ==> 難以判別 來源
'(1)把結果設定成""(下一行程式碼可有可無，因為字串預設值本來就是"")
' 針對本Function的目的來說，結果比較合理性
' EX:把 "C:\12345678\ 34567 TXT" 傳入本 Function ==> 傳出結果 將會是 ""
' JetGetFile_SubName$ = ""
'(2)把結果設定成傳入的字串(去除 路徑)
' 針對 忘了 傳入 . 的參數比較 OK
' EX:把 "MDB" 傳入本 Function ==> 傳出結果 將會是 ""
If JetTrue_Mustbe_SubName Then JetGetFile_SubName$ = JetTemp_FileName$
End If

End Function

Public Function JetGetFileName$(ByVal JetTemp_PathFile$)

' 目的：取得檔案(完整名稱)(藉由分離 檔案 及 路徑)
'
' ●部份功能 ＝ fs.GetFileName(JetTemp_PathFile$)
'
' 參照：
' 【Module】
' (1) 本 Module 中的 JetCheckFileName
'
' =============================================================================
' 參數一(JetPathFile$)：完整路徑 + 檔名
' =============================================================================

JetGetFileName$ = Mid(JetTemp_PathFile$, InStrRev(JetTemp_PathFile$, "\") + 1)
' ◎過瀘掉含有不正當的檔名
If Not JetCheckFileName(JetGetFileName$) Then
MsgBox "一、『" & JetGetFileName$ & "』 檔案名稱可能有誤！" & vbCrLf & " 1.含有不合法的字元" & vbCrLf & " 2.路徑 或 磁碟機代號 不存在" & vbCrLf & vbCrLf & " 導致傳入 JetCheckFileName 的結果是 False！！！" & vbCrLf & vbCrLf & "二、 JetCheckFileName Module 中判斷有誤！", vbCritical, "From 『JetGetFileName$』"
JetGetFileName$ = ""
End If

End Function