• Vui lòng đọc nội qui diễn đàn để tránh bị xóa bài viết
  • Tìm kiếm trước khi đặt câu hỏi

Tìm các ký tự thiếu

Các thủ thuật liên quan đến xử lý chuỗi và thời gian
User avatar
truongphu
VIP
VIP
Posts: 4766
Joined: Sun 04/11/2007 10:57 am
Location: Cam Đức, Khánh hòa
Has thanked: 14 times
Been thanked: 520 times

Tìm các ký tự thiếu

Postby truongphu » Fri 17/10/2008 9:07 am

Thủ thuật: Tìm các ký tự thiếu
Tác giả: truongphu
Mô tả: Tìm chuỗi có các ký tự biết trước. Phụ lục module MsgBox tiếng Việt Unicode


1- Tìm các ký tự thiếu:

Copy bài: Nội quy và cấu trúc phân quyền trong diễn đàn. bởi Admin
http://caulacbovb.com/forum/viewtopic.php?f=27&t=1#p1
dán vào notepad và lưu với tên: "C:\Test.txt", nhớ định dạng là unicode

Chạy đoạn code sau

1a- Chép vào Module

Code: Select all

  1. ' Kiêu gõ UTF8- Literal
  2. ' Module MessageBox hô tro' tiêng Viêt toàn bô
  3. Public Declare Function MessageBox Lib "user32.dll" Alias "MessageBoxW" (ByVal hwnd As Long, ByVal lpText As Long, ByVal lpCaption As Long, ByVal wType As Long) As Long
  4. Public Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByRef lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
  5. Public Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByRef lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpDefaultChar As String, ByVal lpUsedDefaultChar As Long) As Long
  6. Public Const CP_UTF8 = 65001
  7. Public Function UTF82Unicode(ByVal sUTF8 As String) As String
  8. Dim UTF8Size&, BufferSize&, BufferUNI$, LenUNI&, bUTF8() As Byte
  9. If LenB(sUTF8) = 0 Then Exit Function
  10. bUTF8 = StrConv(sUTF8, vbFromUnicode)
  11. UTF8Size = UBound(bUTF8) + 1
  12. BufferSize = UTF8Size * 2
  13. BufferUNI = String$(BufferSize, vbNullChar)
  14. LenUNI = MultiByteToWideChar(CP_UTF8, 0, bUTF8(0), UTF8Size, StrPtr(BufferUNI), BufferSize)
  15. If LenUNI Then UTF82Unicode = Left$(BufferUNI, LenUNI)
  16. End Function
  17. Public Function Msg(ByVal Text As String, Optional ByVal Title As String = "Thông Báo", Optional ByVal FormhWnd As Long = 0) As VbMsgBoxResult
  18. Dim Text1$
  19. Text1 = Unicode2UTF8(Text)
  20. Msg = MessageBox(FormhWnd, StrPtr(UTF82Unicode(Text1)), StrPtr(UTF82Unicode(Title)), 0)
  21. End Function
  22.  
  23. Public Function Unicode2UTF8(ByVal strUnicode As String) As String
  24. Dim LenUNI&, BufferSize&, LenUTF8&, bUTF8() As Byte
  25.  
  26. LenUNI = Len(strUnicode)
  27. If LenUNI = 0 Then Exit Function
  28.  
  29. BufferSize = LenUNI * 3 + 1
  30. ReDim bUTF8(BufferSize - 1)
  31.  
  32. LenUTF8 = WideCharToMultiByte(CP_UTF8, 0, StrPtr(strUnicode), LenUNI, bUTF8(0), BufferSize, vbNullString, 0)
  33.  
  34. If LenUTF8 Then
  35. ReDim Preserve bUTF8(LenUTF8 - 1)
  36. Unicode2UTF8 = StrConv(bUTF8, vbUnicode)
  37. End If
  38. End Function


1b- Chép vào Form

Code: Select all

  1. Private Sub Form_Load()
  2. Const ForReading = 1
  3. Set objFSO = CreateObject("Scripting.FileSystemObject")
  4. Set objFile = objFSO.OpenTextFile("C:\Test.txt", 1, , -2)     'Ðoc unicode
  5.  
  6. Set objRegEx = CreateObject("VBScript.RegExp")
  7. objRegEx.Global = True
  8. objRegEx.Pattern = "\b1....\b"      'Mâu loc ký tu'
  9.  
  10. Do Until objFile.AtendOfStream
  11.     strSearchString = objFile.ReadLine
  12.     Set colMatches = objRegEx.Execute(strSearchString)
  13.  
  14.     If colMatches.Count > 0 Then
  15.         For Each strMatch In colMatches
  16.            a = a & strMatch.Value & vbCr
  17.         Next
  18.     End If
  19. Loop
  20. Msg a
  21. objFile.Close
  22.  
  23. End Sub


2- Nội dung:
Với mẫu tìm: "\b..a.n...\b", nghĩa là tìm chuỗi có 8 ký tự kể cả ký tự space, có 3 đáp án.
Bạn có thể thay đổi mẫu tìm nầy theo objRegEx.Pattern. xin tham khảo bài:
Replace nhiều ký tự số trong chuỗi không dùng vòng lặp
http://caulacbovb.com/forum/viewtopic.php?f=27&t=1980#p11911

ví dụ mẫu: "\b1....\b" có 4 đáp án

3- Module1 hổ trợ MsgBox của bất kỳ chuỗi tiếng Việt Unicode nào, bạn khỏi mất công gõ theo các kiểu định dạng khác rắc rối.
ví dụ có chuỗi: str$ = "Câu Lạc Bộ VB"
Bạn chỉ cần gọi:
Msg str
là xong. Quá khỏe!

Thân tặng các bạn
Attachments
Tìm tu` thiêu.rar
(2.12 KiB) Downloaded 509 times


o0o--truongphu--o0o

.........
Ghé thăm:
Chuyện Linh Tinh

QuangHoa
Guru
Guru
Posts: 542
Joined: Thu 27/03/2008 9:02 am
Location: Quê hương Đại tướng Võ Nguyên Giáp
Been thanked: 5 times
Contact:

Re: Tìm các ký tự thiếu

Postby QuangHoa » Fri 17/10/2008 3:29 pm

Em kiểm tra không được.
Picture1.jpg

P/S bác còn đặt tên Folder mà dùng tiếng Việt thì không tiện chút nào. Vì VB đâu đọc được, phải đổi tên thư mục mới xong. :-<
朋友
这些年一个人风也过雨也走,有过泪有过错还记得坚持什么。
真爱过才会懂会记没会回手,终有梦中有你在心中。
朋友一生一起走那些日子不再有,一句话一辈子一生情一杯九。
朋友不曾孤单过一声朋友你会懂,还有伤还有痛还要走还有我。

User avatar
truongphu
VIP
VIP
Posts: 4766
Joined: Sun 04/11/2007 10:57 am
Location: Cam Đức, Khánh hòa
Has thanked: 14 times
Been thanked: 520 times

Re: Tìm các ký tự thiếu

Postby truongphu » Fri 17/10/2008 3:42 pm

QuangHoa wrote:Em kiểm tra không được.

Lạ nhỉ ?

untitled.JPG


QuangHoa wrote:bác còn đặt tên Folder mà dùng tiếng Việt thì không tiện chút nào. Vì VB đâu đọc được


"Tìm tu` thiêu" không phải là tiếng Việt thuần túy đâu. VB6 vẫn nhận ra! :)
o0o--truongphu--o0o

.........
Ghé thăm:
Chuyện Linh Tinh

User avatar
hiragana
Thành viên chính thức
Thành viên chính thức
Posts: 19
Joined: Sat 01/11/2008 8:34 am
Location: Đà Nẵng xitj
Contact:

Re: Tìm các ký tự thiếu

Postby hiragana » Sun 14/12/2008 9:54 pm

Hix xem xong paste vào bài chạy thử mà ko được pac' ơi!
Em không hiểu cách hoạt động như thế nào nên ko biết fải sửa sao cho phù hợp với bài làm của mình :(
Một trong những hạnh phúc lớn nhất ở đời này là tình bạn, và một trong những hạnh phúc của tình bạn là có một người để gửi gắm những tâm sự thầm kín. :)
Welcome to my blog : http://blogminh.good.to/

User avatar
truongphu
VIP
VIP
Posts: 4766
Joined: Sun 04/11/2007 10:57 am
Location: Cam Đức, Khánh hòa
Has thanked: 14 times
Been thanked: 520 times

Re: Tìm các ký tự thiếu

Postby truongphu » Mon 15/12/2008 5:44 pm

- Bạn chép phần 1a là phần bạn cần, dán vào Module trong Project của bạn:
Mở Project, từ Menu ở trên, chọn Project, trên bảng xổ xuống, chọn hàng thứ 3: add Module, hiện ra biểu tượng Module, click Open
Hiện ra trang code trắng tinh của Module, dán phần 1a vào

- Trở lại code của Form. ví dụ có chuỗi: str$ = "Câu Lạc Bộ VB"
Bạn chỉ cần gọi:

Code: Select all

  1. Msg str

là xong.
o0o--truongphu--o0o

.........
Ghé thăm:
Chuyện Linh Tinh


Return to “[VB] Chuỗi và Thời gian”

Who is online

Users browsing this forum: No registered users and 0 guests