طلب كود لتحميل البيانات من موقع الاسهم السعودية

الاخ Ahmad_prof وضع موضوع في هذا المجال و عن نفس الموقع أعتقد

هذا الكود خاص بستيراد بيانات يوم واحد وهو اخريوم

وما اريده هو استيراد بيانات عام كامل لشركة واحد فقط

ارجو ان تكون الفكرة واضحة

للرفع

ما هي صفحة عرض البيانات التاريخية ؟

لقد قمت بالرد لأنني أيضا أقوم بعمل برنامج مرتبط بموقع الأسهم ..

الاخ العزيز اليك الرابط

http://www.tadawul.com.sa/wps/portal/!...s.7_0_A/7_0_4AI

وعند الضط علي اسم الشركة تفتح صفحة اضغط علي اداء السهم فتخ التواريخ

فتظهر لك بيانات الفترة

سأترك موضوع عمل parsing للبيانات لك ..

المهم

خد بالك في اللينك التالي من المعاملات التي تمرر للفورم

http://www.tadawul.com.sa/wps/portal/!ut/p/.cmd/cp/.c/6_1_LT/.ce/7_1_3H2/.p/5_1_3AO/.pm/V/.ps/X?symbol=1010&tabOrder=2&isNonAdjusted=0&resultPageOrder=1&totalPagingCount=-1&firstinput=2007%2F9%2F01&secondinput=2007%2F9%2F30&si=+%D8%AA%D8%AD%D9%85%D9%8A%D9%84+&s8fid=3119845864410

ستجد معامل symbol بيساوي 1010 لبنك الرياض ..

ومعامل firstinput للحقل الأول للتاريخ

ومعامل secondinput للحقل الثاني للتاريخ

والتاريخ نفسه يتم كتباته علي الصيغة التالية مثلا

firstinput=2007%2F9%2F01

أي

2007/9/01

اي يوم واحد لشهر تسعة لسنة 2007

لاحظ إن الرمز (%2F) ينوب عن الرمز (/)

مثلا :

2007%2F9%2F30

أي

2007/9/30

قم بوضع التاريخ لديك علي نفس الصيغة بداية ونهاية للشركة التي تحددها في معامل symbol ومررها للأداة التي تستخدمها لإسترجاع بيانات الصفحة

http://www.tadawul.com.sa/wps/portal/!...3AO/.pm/V/.ps/X?symbol=1010&tabOrder=2&isNonAdjusted=0&resultPageOrder=1&totalPagingCount=-1&firstinput=2007/9/01&secondinput=2007/9/30&si=+%D8%AA%D8%AD%D9%85%D9%8A%D9%84+&s8fid=3119845864410

لااستخد اداة معينة بل وجدت كود لذلك

واليك الكود

Option Explicit

'Yahoo format

'"http://table.finance.yahoo.com/table.csv?a=5&b=10&c=2000&d=8&e=11&f=2002&s=msft&y=0&g=d&ignore=.csv"

Private sURLcurrent As String, sData As String, iWhichDate As Long

Private sFileSaveName As String, sURLbase As String, iSource As Long

Private iPeriod As Long, sPeriod As String, fCancel As Boolean

Private Sub cmdChangeDir_Click()

Dim s As String

s$ = BrowseForFolder(0, "Select Data Dir", sDataDir$)

If s$ = sEmpty Then Exit Sub

sDataDir$ = s$

Call WriteIni(sINIsetFile, "DLSettings", "DataDir", sDataDir$)

lblDir.Caption = sDataDir$

End Sub

Private Sub cmdGetTheData_Click()

'"http://table.finance.yahoo.com/table.csv?a=5&b=10&c=2000&d=8&e=11&f=2002&s=msft&y=0&g=d&ignore=.csv"

If Not Online() Then _

Call MsgBox("No Connection", vbCritical + vbOKOnly, "No Connection"): Exit Sub

If txtSymbol.Text = sEmpty Then lblStatus.Caption = "No Symbol.. Abort Op": Exit Sub

Screen.MousePointer = vbHourglass

tmrProgress.Enabled = True

Call ConstructURL

sData$ = GetFromInet(sURLcurrent$)

Call ParseAndSaveData

tmrProgress.Enabled = False

Screen.MousePointer = vbDefault

picProgress.Cls

End Sub

Private Sub cmdSelectDate_Click(Index As Integer)

If Index = 0 Then 'begin date

iWhichDate = 0

DatePicker1.InitDate = (Month(Date) - 1 & "/" & Day(Date) & "/" & Year(Date) - 1)

'(DatePart("m", Now) & "/" & _

DatePart("d", Now) & "/" & DatePart("yyyy", Now) - 1)

Else

DatePicker1.InitDate = Date

iWhichDate = 1

End If

DatePicker1.Left = 1560

DatePicker1.Top = 1050

DatePicker1.Visible = True

End Sub

Private Sub DatePicker1_Cancel()

DatePicker1.Visible = False

End Sub

Private Sub DatePicker1_OK(ReturnDate As Date)

DatePicker1.Visible = False

If iWhichDate = 0 Then 'begin date

txtBeginMonth.Text = Format(ReturnDate, "mm")

txtBeginDay.Text = Format(ReturnDate, "dd")

txtBeginYear.Text = Format(ReturnDate, "yyyy")

Else

txtEndMonth.Text = Format(ReturnDate, "mm")

txtEndDay.Text = Format(ReturnDate, "dd")

txtEndYear.Text = Format(ReturnDate, "yyyy")

End If

End Sub

Private Sub Form_Load()

sDataDir$ = GetIni(sINIsetFile, "DLSettings", "DataDir")

If Left$(sDataDir$, 1) = "\" Then sDataDir$ = App.Path & sDataDir$

If Dir(sDataDir$, vbDirectory) = sEmpty$ Then 'not found... make

MkDir sDataDir$

End If

sURLcurrent$ = GetIni(sINIsetFile, "DLSettings", "LastURL")

lblDir.Caption = sDataDir$

txtBeginMonth.Text = Format(Now, "mm")

txtBeginDay.Text = Format(Now, "dd")

txtBeginYear.Text = Format(Now, "yyyy") - 1

txtEndMonth.Text = Format(Now, "mm")

txtEndDay.Text = Format(Now, "dd")

txtEndYear.Text = Format(Now, "yyyy")

iSource = Val(GetIni(sINIsetFile, "DLSettings", "Source"))

optSource(iSource).Value = True

Select Case iSource

Case 0 'yahoo

sURLbase$ = "http://table.finance.yahoo.com/table.csv?"

Case 1

End Select

'http://www.tadawul.com.sa/wps/portal/!ut/p/_s.7_0_A/7_0_4BC/.cmd/ChangeLanguage/.l/en?companySymbol=&ANN_ACTION=ANN_SEARCH&symbol=1020&tabOrder=2

If ViaLAN() Then shpLAN.FillColor = vbGreen

If ViaModem() Then shpModem.FillColor = vbGreen

End Sub

Private Sub Form_Unload(Cancel As Integer)

tmrProgress.Enabled = False

fCancel = True 'get us out of the progress loop if running

Call WriteIni(sINIsetFile, "DLSettings", "DataDir", sDataDir$)

Call WriteIni(sINIsetFile, "DLSettings", "LastURL", sURLcurrent$)

Call WriteIni(sINIsetFile, "DLSettings", "Source", CStr(iSource))

Set frmDownLoad = Nothing

End Sub

Private Sub ConstructURL()

Dim sTemp As String

Select Case iSource

Case 0 'yahoo

'a=5&b=10&c=2000&d=8&e=11&f=2002&s=msft&y=0&g=d&ignore=.csv"

sTemp$ = "a=" & txtBeginMonth.Text & "&b=" & txtBeginDay.Text & "&c=" & txtBeginYear.Text

sTemp$ = sTemp$ & "&d=" & txtEndMonth.Text & "&e=" & txtEndDay.Text & "&f=" & txtEndYear.Text

sTemp$ = sTemp$ & "&s=" & LCase$(txtSymbol.Text) & "&y=0&g="

Select Case iPeriod

Case 0 'daily

sPeriod$ = "d"

Case 1 'weekly

sPeriod$ = "w"

End Select

sTemp$ = sTemp$ & sPeriod$ & "&ignore=.csv"

End Select

sURLcurrent$ = sURLbase$ & sTemp$

txtURL.Text = sURLcurrent$

End Sub

Private Sub ParseAndSaveData()

Dim iFile As Integer, iPos As Long, sLine As String, sFirstLine As String

Dim sTemp As String, iLineCount As Long, sFormat As String, sPath As String

If Len(sData$) < 20 Then

lblStatus.Caption = "Length of data < 20..."

Exit Sub

End If

sFileSaveName$ = txtSymbol.Text & "~" & sPeriod & "-" & Format(Date, "mmddyyyy") & ".dat"

sPath$ = sDataDir$ & "\" & sFileSaveName$

iFile = FreeFile

Select Case iSource

Case 0 'yahoo

iPos = InStr(sData$, "Date") 'dump everything before "Date"

If iPos = 0 Then lblStatus.Caption = "Error with Data, ""Date"" not found": Exit Sub

sData$ = Mid$(sData$, iPos)

sData$ = Replace(sData$, Chr$(10), vbCrLf) 'give us separate lines

Open sPath$ For Output Access Write Lock Write As #iFile

Print #iFile, sData$

Close #iFile

lblStatus.Caption = "Parsing File..."

sData$ = "" 'empty data string

'tested faster to open the file and get each line at a time then to parse

'the original string when replacing the dates

Open sPath$ For Input Access Read As #iFile

Do While Not EOF(iFile)

DoEvents

Line Input #iFile, sLine$

iLineCount = iLineCount + 1

If Len(sLine$) > 2 Then

iPos = InStr(sLine$, ",")

If iPos <> 0 Then

sTemp$ = Mid$(sLine$, 1, iPos - 1) 'get the first token... it is the date

If IsDate(sTemp$) Then 'make sure it is a date

sFormat$ = Format(sTemp$, "mm/dd/yyyy") 'better format than original

sLine$ = Replace(sLine$, sTemp$, sFormat$) 'replace it

End If

'build new file with temp string. Reverse the order the so an update

'only needs an append. The chart data loader expects it that way also.

If iLineCount = 1 Then 'not the first line

sFirstLine$ = sLine$ 'first line is the format header save till later

ElseIf iLineCount = 2 Then

sData$ = sLine$

Else

sData$ = sLine$ & vbCrLf & sData$

End If

End If

End If

Loop

sData$ = sFirstLine$ & vbCrLf & sData$ 'put at the head of the file

Close #iFile

Case 1

End Select

Open sPath$ For Output Access Write Lock Write As #iFile

Print #iFile, sData$ 'save the formatted data

Close #iFile

lblStatus.Caption = "Operation Complete"

End Sub

Private Sub optPeriod_Click(Index As Integer)

iPeriod = Index

End Sub

Private Sub tmrAfterLoad_Timer()

tmrAfterLoad.Enabled = False

Call PositionMousePointer(Me.hWnd, Me.Width \ 2, Me.Height / 2, False)

End Sub

Private Sub tmrProgress_Timer()

Dim i As Long, iColor As Long, x As Long, y As Long, fIn As Boolean, j As Long

If fIn Then Exit Sub

fIn = True

x = picProgress.ScaleWidth \ 2

y = picProgress.ScaleHeight \ 2

For i = 1 To 120 '70

'If i = 120 Then DoEvents

If fCancel Then Exit For

j = (i \ 10)

If j < 1 Then j = 1

picProgress.DrawWidth = j

iColor = RGB(0, 255 - i * 2, 0)

picProgress.FillColor = iColor

picProgress.Circle (x, y), i * 10, vbGreen

picProgress.DrawWidth = j

If i > 24 Then picProgress.Circle (x, y), (i - 25) * 10 + 1, RGB(0, 255 - i, 0)

If i > 54 Then picProgress.Circle (x, y), (i - 55) * 10 + 1, RGB(0, 255 - i - j * 5, 0)

'picProgressV.Picture = picProgress.Image

Call BitBlt(picProgressV.hDC, 0, 0, _

picProgressV.ScaleWidth \ Screen.TwipsPerPixelX, _

picProgressV.ScaleHeight \ Screen.TwipsPerPixelY, _

picProgress.hDC, 0, 0, SRCCOPY)

picProgressV.Refresh

Delay 0.05

Next

fIn = False

End Sub

Private Sub txtSymbol_Change()

txtSymbol.Text = UCase(txtSymbol.Text)

txtSymbol.SelStart = Len(txtSymbol.Text)

Call ConstructURL

End Sub

أخي awajihm

بماذا سيستفيد أحد من الكود الذي وضعته .. وقد وضعته ناقص الكثير ..

المهم إن الإجراء GetFromInet والذي لم تضع كوده .. بما هو من اسمه يعتمد علي الأداة MS Internet Transfer

وقد كنت استخدم هذه الأداة سابقا نظرا لسرعتها .. ولكنها تعود بالبيانات بصيغة سيئة .. وتدخل في مود Blocking علي الـ Main Thread لبرنامجك حتي تسترجع جميع البيانات .. وبالتالي فهي تهنج البرنامج .. وأيضا صعب شوية تقدير النسبة المئوية لحجم إسترجاع البيانات ..

ولذلك لم أعتمد عليها وأعتمدت علي أداة الـ WebBrowser .. فهي أفضل .. وتحل المشاكل السابقة .. ولكنها أبطأ من الأداة السابقة ..