مشكل در ارسال لينك جستجو به بروزر

[mohammadsaleh]

سلام دوستان در نمونه زير وقتي در تكست باكس از كلمات لاتين استفاده كنيم درست عمل مي كند مثلا اگر كلمه tehran را بنويسيم نقشه تهران در گوگل جستجو و نمايش داده مي شود اما اگر به صورت فارسي بنويسيم جستجو انجام نمي شود و كلمه تهران را به صورت علائم ارسال مي كند. به نظرم قبل از ارسال لينك مي بايست لينك به قالب يونيكد utf8 تبديل شود. اما نتوانستم راهي براي آن بيابم.
البته مشكل را در قسمت ديگري از سايت مطرح كردم ولي بي پاسخ ماند.

[mohammadsaleh]

سلام بر اساتيد بزرگوار.
من كماكان منتظرم

[e601]

سلام
پاسخ رو بصورت کد همینجا مینویسم تا استفاده اش برای دوستانی که بعدها هم به تاپیک مراجعه میکنند راحت تر باشه.
شما ابتدا باید کد زیر رو به کدهای فرم خودتون اضافه کنید: (البته به نکته ای که در آخر پست نوشتم هم توجه کنید)

Private Const CP_UTF8 = 65001
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

Public Function UTF16To8(ByVal UTF16 As String) As String
Dim sBuffer As String
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


روش استفاده :
مثلا در مورد نمونه ای که قرار دادید کد رویداد کلیک دکمه شما بصورت زیر میشه. یادتون باشه که برای جایگزینی space با + نیازی به استفاده از تابع Replace نیست چون خود تابع این کار رو انجام میده.

Private Sub Command2_Click() Dim strURL As String
strURL = "http://maps.google.com/maps?q=" & URLEncode(Me.Text0, True, True)
Application.FollowHyperlink strURL
End Sub


نکته:
اگر برنامه شما فقط یک فرم داره که همچین عملکردی ارائه میده میتونید کد توابع اصلی رو داخل همون فرم قرار داده و استفاده کنید ولی اگر برنامه شما شامل چندین فرم مختلف هست که از این توابع استفاده میکنه راه قشنگ تر اینه که یه ماژول درست کنی و کد توابع رو داخل اون بذاری تا نیازی نباشه کدها رو در تمام فرمها کپی پیست کنی...

[mohammadsaleh]

سلام تشکر از زحمتی که کشیدید. نمیدونم چرا کلمات فارسی را به بروزر نمیفرسته

[e601]

سلام

کد قبلی بدلیل اینکه از api ویندوز برای انکدینگ حروف فارسی استفاده میکنه در ویندوزهای 64 بیتی به مشکل میخوره. البته راه حل داره ولی به دردسرش نمی ارزه.

از کد زیر استفاده کنید. این کد رو به کدهای فرم خودتون اضافه کنید :

Private Const adTypeBinary As Long = 1
Private Const adTypeText As Long = 2
Private Const adModeReadWrite As Long = 3

Public Function URLEncode(ByVal StringToEncode As String) As String
Dim i As Integer
Dim iAsc As Long
Dim sTemp As String
Dim ByteArrayToEncode() As Byte
ByteArrayToEncode = ADO_EncodeUTF8(StringToEncode)
For i = 0 To UBound(ByteArrayToEncode)
iAsc = ByteArrayToEncode(i)
Select Case iAsc
Case 32
sTemp = "+"
Case 48 To 57, 65 To 90, 97 To 122
sTemp = Chr(ByteArrayToEncode(i))
Case Else
sTemp = "%" & Hex(iAsc)
End Select
URLEncode = URLEncode & sTemp
Next
End Function

Public Function ADO_EncodeUTF8(ByVal strUTF16 As String) As Byte()
Dim objStream As Object
Dim data() As Byte
Set objStream = CreateObject("ADODB.Stream")
objStream.Charset = "utf-8"
objStream.Mode = adModeReadWrite
objStream.Type = adTypeText
objStream.Open
objStream.WriteText strUTF16
objStream.Flush
objStream.Position = 0
objStream.Type = adTypeBinary
objStream.Read 3
data = objStream.Read()
objStream.Close
ADO_EncodeUTF8 = data
End Function


طرز استفاده رو هم که میدونید. در رویداد کلیک دکمه :

Dim strURL As String
strURL = "http://maps.google.com/maps?q=" & URLEncode(Me.Text0)
Application.FollowHyperlink strURL


این کد هم خودش space رو به + تبدیل میکنه.

به احتمال 99% مشکل شما با این کد حل میشه...

[mohammadsaleh]

سلا و تشکر از جنابعالی. باعث افتخار است که دوستانی چون شما در تالار اکسس همچون خورشید بخشنده دانش خود را که با رنج به دست آورده اند با دیگران تقسیم می کنند. آرزوی سلامتی و موفقیت شما را دارم.
با لطف شما مشکل حل شد.

البته یک راه حل هم خودم پیدا کردم و آن اینکه به جای ارسال کلمات فارسی یونیکد حروف را ارسال می کنیم. با استفاده از تابع ASCW

[alirezabahrami]

سلا و تشکر از جنابعالی. باعث افتخار است که دوستانی چون شما در تالار اکسس همچون خورشید بخشنده دانش خود را که با رنج به دست آورده اند با دیگران تقسیم می کنند. آرزوی سلامتی و موفقیت شما را دارم.
با لطف شما مشکل حل شد.



سلام !
آقاس مسعودی عزیز ، یکی از اساتید قدیمی این تالار بوده و هستند که در گذشته دوستان تالار اکسس همواره از تجارب و تخصص ایشان بهره مند میشدند .
شخصاً ، از حضور مجدد ایشان در این تالار خیلی خوشحالم . و به ایشان خوش آمد می گویم .
امیدوارم سایر دوستان و اساتید قدیمی نیز که هرکدام ارائه دهنده خدمات ارزشمندی در این تالار بوده اند در هر کجا و مشغول هر فعالیت دیگری هستند در پناه خدا سالم و تندرست باشند.
یا علی

[e601]

سلام !
آقاس مسعودی عزیز ، یکی از اساتید قدیمی این تالار بوده و هستند که در گذشته دوستان تالار اکسس همواره از تجارب و تخصص ایشان بهره مند میشدند .
شخصاً ، از حضور مجدد ایشان در این تالار خیلی خوشحالم . و به ایشان خوش آمد می گویم .
امیدوارم سایر دوستان و اساتید قدیمی نیز که هرکدام ارائه دهنده خدمات ارزشمندی در این تالار بوده اند در هر کجا و مشغول هر فعالیت دیگری هستند در پناه خدا سالم و تندرست باشند.
یا علی

جناب بهرامی عزیز ممنون از نظر لطفی که نسبت به بنده داشتید. واقعا از محبت دوستانی مثل شما و عزیزان دیگه که پیام خصوصی هم برای من فرستاند و من رو شرمنده کردند ممنونم. واقعیتش اینه که من 1-2 سالی بود که به این سایت سر نمیزدم و هفته پیش هم با کلی دنگ و فنگ تونستم به اکانتم وارد بشم چون تمام پسورد و ایمیل ثبت نامی و ... رو فراموش کرده بودم !
همین محبتهای شما دوستان بزرگوار باعث شده که من تصمیم بگیرم فعالیتم در تالار اکسس رو تا جایی که بتونم استمرار ببخشم و در حد توان و اطلاعات خودم دوستان رو راهنمایی کنم.
بازم ممنون

[New Account]

سلام

شما میتونید موضوع رو ساده تر مدیریت کنید و از حداقل کدینگ بهره ببرید ( تقریبا یک خط )

این خط از کدینگتون رو :


Application.FollowHyperlink strURL

با این خط عوض کنید :


ShellExecute Me.hwnd, "open", strURL, "", "C:\", SW_SHOWNORMAL

و این قطعه کد زیر رو هم در داخل یک ماژول ذخیره کنید ( فرخوانی تابع ShellExecute ) :



Public Declare Function ShellExecute _
Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long



کدینگ پیچیده شما رو در مدیریت اون با سختی مواجه خواهند کرد و تا حد ممکن از اونها باید دوری کنید

موفق باشید

[e601]

همونطوری که عرض کردم استفاده از کدهای دسترسی به api ویندوز در ویندوزهای 64 بیتی ایجاد مشکل میکنه. یعنی در واقع استفاده از کلید واژۀ Declare به تنهایی، در ویندوزهای 64 بیتی منجر به بروز خطا میشه و باید همراه با کلید واژۀ جدید PtrSafe استفاده بشه. بصورت زیر :

Public Declare PtrSafe Function ...

ظاهرا برای نوشتن همچین کدی که هم در ویندوز 64 بیتی و هم در ویندوز 32بیتی درست کار کنه باید از کامپایل شرطی استفاده کرد (یعنی #IF #Then #Else) ولی اون رو هم من تست کردم ارور میده. بخاطر همین در پستهای بالاتر عرض کردم استفاده از api دردسر داره...

[New Account]

همونطوری که عرض کردم استفاده از کدهای دسترسی به api ویندوز در ویندوزهای 64 بیتی ایجاد مشکل میکنه. یعنی در واقع استفاده از کلید واژۀ Declare به تنهایی، در ویندوزهای 64 بیتی منجر به بروز خطا میشه و باید همراه با کلید واژۀ جدید PtrSafe استفاده بشه. بصورت زیر :

Public Declare PtrSafe Function ...

ظاهرا برای نوشتن همچین کدی که هم در ویندوز 64 بیتی و هم در ویندوز 32بیتی درست کار کنه باید از کامپایل شرطی استفاده کرد (یعنی #IF #Then #Else) ولی اون رو هم من تست کردم ارور میده. بخاطر همین در پستهای بالاتر عرض کردم استفاده از api دردسر داره...

سلام دوست من

مطلب شما رو مطالعه کرده بودم و توضیحی که درج فرمودید رو هم مشاهده کردم ولیکن تصور میکنم توضیحتون در این خصوص صحیح نیست

کدی که درج شده فاقد اشکاله و به درستی در ویندوز 64 بیتی کار میکنه

من حدس میزنم شما منظورتون آفیس 64 بیتی باشه

کد شما رو تست نکردم ولی وقتی اون رو درج کردید حتما تست شده و درسته , بنده فقط اشارم به ساده تر بودن و کوتاه تر بودن کد بود

موفق باشید

[e601]

بله منظورم همون آفیس 64 بیتی بود. تذکر درست و بجایی بود.
در کل نظر شخصی من اینه که تا حد امکان، استفاده نکردن از api ویندوز ارجحیت داره چون این مورد یکی از اختلالاتی هست که میدونیم پیش میاد و ممکنه اختلالات دیگه ای هم بعدها بوجود بیاد که تا حالا برامون پیش نیومده و زحمت پشتیبانی از کاربران رو برای ما بیشتر کنه.
به هر حال صلاح مملکت خویش خسروان دانند...

[New Account]

سلام دوست قديمي

متاسفانه بخش زيادي از مبحثتون صحيح نيست و چون قصد توجه كردن به مطلب طرف مقابل رو هم نداريد ترجيح ميدم ادامه ندم
اين رو هم نوشتم كه عدم ادامه بحث فني دليلي بر صحيح بودن مطلبي كه درج كرديد نيست
بنده حوصله گفتگوي اون زمان گذشته رو ندارم دوست خوبم

همونطوري كه خودتون هم فرموديد : صلاح كار خويش خسروان دانند

يك نظري شما داريد و يك نظري هم بنده ، قطعا از ديدگاه خودمون نه ماست شما ترشه و نه ماست بنده ، كاربران انتخاب ميكنند ، حالا هر چه قدر كه ميخوايم ما دو تا با هم بحث كنيم ....

تجربه راه رو مشخص خواهد كرد

موفق باشيد

[e601]

سلام دوست قديمي

متاسفانه بخش زيادي از مبحثتون صحيح نيست و چون قصد توجه كردن به مطلب طرف مقابل رو هم نداريد ترجيح ميدم ادامه ندم
اين رو هم نوشتم كه عدم ادامه بحث فني دليلي بر صحيح بودن مطلبي كه درج كرديد نيست
بنده حوصله گفتگوي اون زمان گذشته رو ندارم دوست خوبم

همونطوري كه خودتون هم فرموديد : صلاح كار خويش خسروان دانند

يك نظري شما داريد و يك نظري هم بنده ، قطعا از ديدگاه خودمون نه ماست شما ترشه و نه ماست بنده ، كاربران انتخاب ميكنند ، حالا هر چه قدر كه ميخوايم ما دو تا با هم بحث كنيم ....

تجربه راه رو مشخص خواهد كرد

موفق باشيد

سلام
اینجوری که شما صحبت کردی من کنجکاو شدم که ببینم قضیه چیه. اگر درست حدس زده باشم شما همون آقای پیروزمهر عزیز هستی که قبلا هم ما با هم مباحثه زیاد میکردیم. با فرض اینکه شما همون آقای پیروزمهر هستی و با توجه به مطالبی که فرمودید تصمیم گرفتم پاسخی خدمتتون عرض میکنم:


بنده حوصله گفتگوي اون زمان گذشته رو ندارم دوست خوبم
البته اینجوری که از ظواهر امر بر میاد و قبلا هم برمیومد شما ماشالله همیشه حوصله زیاد داری. شکسته نفسی فرمودید (شوخی دوستانه بود) :چشمک:


متاسفانه بخش زيادي از مبحثتون صحيح نيست و چون قصد توجه كردن به مطلب طرف مقابل رو هم نداريد ترجيح ميدم ادامه ندم
اولا که نمیدونم کجای بحث رو میفرمایید صحیح نیست؟ من نظرم رو گفتم و همیشه هم گفتم تا جایی که بشه بهتره که در اکسس از ابزارها و استانداردهای داخلی خود اکسس برای طراحی برنامه هامون استفاده کنیم. حالا شما میتونی قبول کنی میتونی قبول نکنی. فتوا ندادم که !
دوما من نمیفهمم چرا شما میگید که قصد توجه کردن به صحبتهای طرف مقابل رو ندارم؟! من که در پست قبلی گفتم تذکر بجایی دادید! دقیقا کجای حرفهام به شما برخورده؟! :متفکر:


يك نظري شما داريد و يك نظري هم بنده ، قطعا از ديدگاه خودمون نه ماست شما ترشه و نه ماست بنده ، كاربران انتخاب ميكنند ، حالا هر چه قدر كه ميخوايم ما دو تا با هم بحث كنيم ....

تجربه راه رو مشخص خواهد كرد
والا من همون قدیم که در این تالار فعال بودم و هم الان که چند روزه چندتا پست فرستادم هیچ وقت ادعایی نداشتم. همیشه گفتم در حد توان خودم اگر پاسخ سوالی رو بدونم به دوستان میگم شاید کمکی براشون باشه.
و الان هم رسما اعلام میکنم که کاربران عزیز در هر تاپیکی من پاسخی دادم و آقای پیروزمهر هم پاسخ دادند حتما به پاسخ ایشون بیشتر استناد و اعتماد کنید...

یا علی

[mahmooddavoodi]

من به نوبه خودم از هر دو استاد بزرگوار تشکر می کنم و وجود شما رو غنیمت می دونم..ممنون که هستید..و ارزوی قلبیم اینه که همیشه باشید چون خیلیا به علم شما و تجربه های ارزشمندتون احتیاج دارن..خدا قوت علی یارتون.