טוב קודם כל נפתר לא ממש, כי הדיבוג עובר, אבל בסופו של יום הפונקציה לא מחזירה לי כל ערך, אני אציג את הקוד שעשיתי:
Private Const CP_UTF8 = 65001
#If VBA7 Then
Private Declare PtrSafe Function WideCharToMultiByte Lib "Kernel32" ( _
ByVal CodePage As LongPtr, ByVal dwflags As LongPtr, _
ByVal lpWideCharStr As LongPtr, ByVal cchWideChar As LongPtr, _
ByVal lpMultiByteStr As LongPtr, ByVal cchMultiByte As LongPtr, _
ByVal lpDefaultChar As LongPtr, ByVal lpUsedDefaultChar As LongPtr) As Long
#Else
Private Declare Function WideCharToMultiByte Lib "Kernel32" ( _
ByVal CodePage As Long, ByVal dwflags As Long, _
ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, _
ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, _
ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long
#End If
Public Function UTF16To8(ByVal UTF16 As String) As String
'עקב שגיאה ב 64 ביט יש להשבית את הפונקציה בשלב זה
Dim lLength As Long
If UTF16 <> "" Then
lLength = WideCharToMultiByte(CP_UTF8, 0, StrPtr(UTF16), -1, 0, 0, 0, 0)
sBuffer = space$(lLength)
lLength = WideCharToMultiByte(CP_UTF8, 0, StrPtr(UTF16), -1, StrPtr(sBuffer), Len(sBuffer), 0, 0)
sBuffer = StrConv(sBuffer, vbUnicode)
UTF16To8 = Left$(sBuffer, lLength - 1)
Else
UTF16To8 = ""
End If
End Function
Public Function URLEncode( _
StringVal As String, _
Optional SpaceAsPlus As Boolean = False, _
Optional UTF8Encode As Boolean = True _
) As String
Dim StringValCopy As String: StringValCopy = IIf(UTF8Encode, UTF16To8(StringVal), StringVal)
Dim StringLen As Long: StringLen = Len(StringValCopy)
If StringLen > 0 Then
ReDim result(StringLen) As String
Dim i As Long, CharCode As Integer
Dim char As String, space As String
If SpaceAsPlus Then space = "+" Else space = "%20"
For i = 1 To StringLen
char = Mid$(StringValCopy, i, 1)
CharCode = Asc(char)
Select Case CharCode
Case 97 To 122, 65 To 90, 48 To 57, 45, 46, 95, 126
result(i) = char
Case 32
result(i) = space
Case 0 To 15
result(i) = "%0" & Hex(CharCode)
Case Else
result(i) = "%" & Hex(CharCode)
End Select
Next i
URLEncode = Join(result, "")
End If
End Function
אז הפונקציה URLEncode לא מחזירה לי כל ערך.
@ClickOne
מה זה קוד השלמה אוטו' של כל הערים וכו?
אתה מתכוון לזה?
לא! זה קובץ XML שלוקח לו שבוע לעלות ושוקל המון, אתה צריך להחזיק אותו אצל הלקוח, בקיצור לא יעיל בעליל. אני מדבר על קוד שמתקשר אונליין עם השרת של דואר ישראל, ומושך ממנו מידע של השלמה אוטומטית, של ערים, ולאחר מכן של הרחובות באותה עיר, אבל אני לא ימרה את פיו של מנהל הפורום.
לגבי עידוד שימוש באקסס, אני מצהיר בזאת שאני משתמש בזה מתוך אילוץ גמור, הואיל ואני כרגע מתפרנס מזה, אבל אני בתהליך של הגירה, יעיד כל כך מג'יקוד...
בכל אופן אני עדיין לא יכול לסמן את הבעיה כנפתרה, כל עוד הפונקציה URLEncode לא מחזירה לי כל ערך..
פורסם במקור בפורום CODE613 ב12/02/2014 19:18 (+02:00)
