ايران ويج

صفحه‌ها: 1 2

دوست عزیز من درآوردن سورس وبو یادم نمیاد توی این انجمن قبلا دیده بودمش،اگر کسی لینک اون پستو به من بده من به طور دقیق اونی رو که می خواهی بهت میدم Laugh

خودم وقت نمی کنم بگردم Whistle

با سلام دوست عزیز
رفتم تا اتاق فکر یادم امد.ابتدا یک ماژول ایجاد کن و کدهای زیر را در آن قرار بده

کد: 
Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long

Private Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" (ByVal hInternetSession As Long, ByVal sURL As String, ByVal sHeaders As String, ByVal lHeadersLength As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long

Private Declare Function InternetReadFile Lib "wininet.dll" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer

Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer

Private Const IF_FROM_CACHE = &H1000000

Private Const IF_MAKE_PERSISTENT = &H2000000

Private Const IF_NO_CACHE_WRITE = &H4000000

Private Const BUFFER_LEN = 256

Public Function GetUrlSource(sURL As String) As String

    Dim sBuffer As String * BUFFER_LEN, iResult As Integer, sData As String

    Dim hInternet As Long, hSession As Long, lReturn As Long

    hSession = InternetOpen("vb wininet", 1, vbNullString, vbNullString, 0)

    If hSession Then hInternet = InternetOpenUrl(hSession, sURL, vbNullString, 0, IF_NO_CACHE_WRITE, 0)

    If hInternet Then

        iResult = InternetReadFile(hInternet, sBuffer, BUFFER_LEN, lReturn)

        sData = sBuffer

        Do While lReturn <> 0

            iResult = InternetReadFile(hInternet, sBuffer, BUFFER_LEN, lReturn)

            sData = sData + Mid(sBuffer, 1, lReturn)

        Loop

    End If

    iResult = InternetCloseHandle(hInternet)

    GetUrlSource = sData

End Function

حا در فورم یک Text و یک Command در بخش کد Command

کد: 
Private Sub Command1_Click()

Text1.Text = ""

s = GetUrlSource(WebBrowser1.LocationURL)

urls1 = InStr(1, s, "Comment :")

urls1 = urls1 + 740

urls2 = InStr(urls1, s, "<")

url = Mid(s, urls1, urls2 - urls1)

Text1 = url

End Sub

در کد بالا ما کدهای آدرس موجود در WebBrowser1 را در میآوریم و بررسی می کنیم پس شما باید قبلا به صفحه ی مورد نظر رفته باشید
این کد بالا فقط مقدار جلوی Comment را بر میگرداند اگر اشتباه نکرده باشم شما هم اینو می خواستید
در ضمن امکان تستش هم نداشتم ولی 100% کار می کنه،ولی من تست نکردم
یک راه دگه هم هست که دگه حالشو ندارم،اگر خواستی بگو تا اونو هم بگم ولی همین بهتره Wink

با تشکر از شما دوست من

ولی این کد مقدار ght_textarea_line_light">  رو برای من برگشت داد

من میخواستم اطلاعات رو بگیرم

Address , phone , cell phone , name , comment

دوست عزیز من امکان تست که ندارم ولی یه جای دیگه تست کردم جواب داد ببین اون آدرس در WebBrowser1 باز است؟
نمیدونم ولی برای
Address :

کد: 
Private Sub Command1_Click()

Text1.Text = ""

s = GetUrlSource(WebBrowser1.LocationURL)

urls1 = InStr(1, s, "Address :")

urls1 = urls1 + 744

urls2 = InStr(urls1, s, "<")

url = Mid(s, urls1, urls2 - urls1)

Text1 = url

End Sub

توضیحات :

کد: 
s = GetUrlSource(WebBrowser1.LocationURL)

کد بالا کد html صفحه را در می آورد و درون s قرار می دهد

کد: 
urls1 = InStr(1, s, "Address :")

مکان شروع رشته ی "Address :" را در کد html بدست می آورد

کد: 
urls1 = urls1 + 744

چرا 744 چون تعداد کارکتر های بین "Address :" تا مقدار جلوی آن کارکتر وجود دارد این کارکتر ها به صورت زیر هستند

کد: 
Address :</td><td class="Form_Content_Row_End"><img border="0" src="./IBSng   User Information_files/end_of_row_light.gif"></td></tr></tbody></table></td><td colspan="2" class="Form_Content_Row_Right_Textarea"><table border="0" width="100%" cellspacing="0" cellpadding="0"><tbody><tr><td class="Form_Content_Row_Textarea_corner"><img border="0" src="./IBSng   User Information_files/top_left_of_comment_light.gif"></td><td class="Form_Content_Row_Top_textarea_line_light"></td><td class="Form_Content_Row_Textarea_corner"><img border="0" src="./IBSng   User Information_files/top_right_of_comment_light.gif"></td></tr><tr><td class="Form_Content_Row_Left_textarea_line_light">&nbsp;</td><td class="Form_Content_Row_Right_textarea_td_light"><br>

تعداد کارکتر ها با فاصله ها 744 تا هستند تا به اول مقدار جلوی "Address :" برسیم(شاید نباید فاصله ها را حساب کرد پس یک بار به جای 744 قرار بده 713)

کد: 
urls2 = InStr(urls1, s, "<")

ما پایان رشته ی جلوی "Address :" را پیدا می کنیم چون بعد از اون رشته یه تگ باز می شود ">"

کد: 
url = Mid(s, urls1, urls2 - urls1)

ما کارکتر های بیت urls1 و (urls2 - urls1) را جدا کرده و در url قرار می دهیم
این کد باید کارکند نمی دونم چرا چیز های دیگری می آورد

برای phone :

کد: 
Private Sub Command1_Click()

Text1.Text = ""

s = GetUrlSource(WebBrowser1.LocationURL)

urls1 = InStr(1, s, "phone :")

urls1 = urls1 + 732

urls2 = InStr(urls1, s, "<")

url = Mid(s, urls1, urls2 - urls1)

Text1 = url

End Sub

برای cell phone :

کد: 
Private Sub Command1_Click()

Text1.Text = ""

s = GetUrlSource(WebBrowser1.LocationURL)

urls1 = InStr(1, s, "Cell Phone Number :")

urls1 = urls1 + 750

urls2 = InStr(urls1, s, "<")

url = Mid(s, urls1, urls2 - urls1)

Text1 = url

End Sub

برای name :

کد: 
Private Sub Command1_Click()

Text1.Text = ""

s = GetUrlSource(WebBrowser1.LocationURL)

urls1 = InStr(1, s, "Name :")

urls1 = urls1 + 731

urls2 = InStr(urls1, s, "<")

url = Mid(s, urls1, urls2 - urls1)

Text1 = url

End Sub

باید کار کنــــــــــــــــــــــــــــــــــــــــــــــــــه

دوست من ممنونم از توضیحات کاملت اما نشد

مثل قبل برمیگردونه

یکم ور رفتم با کد باز هم نشد

صفحه‌ها: 1 2

javaweb

javaweb

sevdaboy

javaweb

sevdaboy