PureBasic - форум

Пётр · Поделиться**151**24.06.2011 00:26:14

Вот с упаковкой файла GismeteoCodSity.txt http://pure-basic.narod.ru/forum/modjet_23_06_2011.rar
Заполнение выпадающих списков вынес в отдельный поток и теперь прога стартует за долю секунды.

+1

max · [1985-03-29]

Зачет! :cool: Спасибо!

0

max · [1985-03-29]

Вопрос не в тему.

Код:

MessageRequester("", "ОК", #MB_OK|#MB_ICONINFORMATION)

Где можно посмотреть все флаги MessageRequester? :huh:

0

Пётр · Поделиться**154**24.06.2011 15:55:28

max написал(а):

де можно посмотреть все флаги MessageRequester?

Здесь http://msdn.microsoft.com/en-us/library/ms645505

Но можно использовать эту прогу, которая сама сгенерирует требуемый код http://purebasic.info/phpBB2/viewtopic.php?t=291

0

max · [1985-03-29]

Спасибо.

0

max · [1985-03-29]

radan любезно предоставил исходники библиотек.
Может кто переведет их на пурик или подскажет как это сделать?
Заранее спасибо!

0

ВиниПур · Поделиться**157**26.06.2011 21:32:52

max написал(а):

Может кто переведет их на пурик или подскажет как это сделать?

А чем они хороши? Всё то же самое, что и у нас, читает файл при помощи URLDownloadToFile и производит разбор полученного файла. Manu_ru при помощи регулярных выражений, Many_uk при помощи замены (Replace) тегов на пробелы, Прогноз погоды как и у нас, разбор XML.
Нет ни чего уникального, всё посредственно, даже банально.
Если только url нужен?
url = "http://bank.gov.ua/Fin_ryn/OF_KURS/Currency/FindByDate.aspx?__EVENTARGUMENT=&__EVENTTARGET=&Text1=" & datas
url = "http://www.cbr.ru/currency_base/D_print.aspx?date_req=" & datas
url = "http://informer.gismeteo.ru/xml/" & sity_id & "_1.xml"

0

max · [1985-03-29]

ВиниПур написал(а):

А чем они хороши?

Дело не в том, хороши они или нет, а в том, что по ним можно разобраться, как сделать курсы валют как в оригинальной проге. Если есть возможность разобрать htmlфайл, почему же не воспользоваться.

ВиниПур написал(а):

Прогноз погоды как и у нас

С прогнозом мы уже разобрались.

Отредактировано max (26.06.2011 21:51:05)

0

max · [1985-03-29]

ВиниПур написал(а):

Нет ни чего уникального, всё посредственно, даже банально.

radan написал(а):

Только не смейтесь над кодом...

0

ВиниПур · Поделиться**160**26.06.2011 22:15:34

max написал(а):

Только не смейтесь над кодом...

Да над чем смеяться то? Нормальный код.
Хочешь так же ка у него? Go в справку Пурика RegularExpression, сами регулярные выражения копируешь с его кода, он в файле Many_ru\Many_ru\Class_many.vb. По идее правильное выражение работает в не зависимости от языка - это отдельная фишка. Ну естественно чисто VB-шные константы типа & vbCr & vbLf & меняем на Пуриковские + #CRLF$ +

0

max · [1985-03-29]

Спасибо. Буду пробовать.

0

Пётр · Поделиться**162**26.06.2011 23:52:45

Чет, не получается внятно расшифровать кириллицу с сайта! :tired:
Вроде там UTF8, но в место кириллица, знаки вопроса.....

А процедура Many_ru должна быть примерно такой:

Код:

Procedure.l DownloadToMem(URL.s, *lpRam, ramsize.l) 
  Protected agent.s, hInet.l, hData.l, Bytes.l 
  
  agent.s = "IE 6.0" 
  hInet.l = InternetOpen_ ( @agent.s,0,0,0,0 ) 
  hData.l = InternetOpenUrl_ ( hInet, @URL.s, "", 0, $8000000, 0 ) 
  
  If hData > 0 : InternetReadFile_ ( hData, *lpRam, ramsize.l, @Bytes.l ) : Else : Bytes = -1 : EndIf 
  
  InternetCloseHandle_ (hInet) 
  InternetCloseHandle_ (hFile) 
  InternetCloseHandle_ (hData) 
  
  ProcedureReturn Bytes.l 
EndProcedure 

Procedure.s Many_ru()
  Protected Result.s, *mem, Many.s
  Protected url.s, Bytes, Datas.s, html.s
  Protected Dim Result$(0), ManyExpression.s
  Protected Pos
  
  Result = "Ошибка"
  Datas = FormatDate("%dd.%mm.%yyyy",Date())
  url = "http://www.cbr.ru/currency_base/D_print.aspx?date_req="+Datas
  
  *mem = AllocateMemory(200000)
  If *mem
    Bytes = DownloadToMem(url, *mem, 200000)
    If Bytes
      html = PeekS(*mem, -1, #PB_UTF8)
      ShowMemoryViewer(@html, Bytes)
      If html<>""
        Result = "Центральный банк Российской Федерации установил следующие курсы иностранных валют к рублю Российской Федерации  на " + Datas + ":" + Chr(10)
        Restore Many_ru
        For i=1 To 34
          Read.s Many
          Pos = FindString(Many, " ", 1)
          ManyExpression = Right(Many, Len(Many)-Pos)
          If CreateRegularExpression(0, ManyExpression+"</td>" + #CRLF$ + "<td align="+Chr(34)+"right"+Chr(34)+">(.*)</td>")
            If ExtractRegularExpression(0, html, Result$())>0
              ;Debug Result$(0)
              Result + Many+" = "+Result$(0)+"руб.;"
            EndIf
            FreeRegularExpression(0)
          EndIf
        Next i
      EndIf
    EndIf
    FreeMemory(*mem)
  EndIf
  
  ProcedureReturn Result
EndProcedure

Debug Many_ru()

DataSection
  Many_ru:
  Data.s "1 Австралийский доллар", "1 Азербайджанский манат", "1000 Армянских драмов", "10000 Белорусских рублей"
  Data.s "1 Болгарский лев", "1 Бразильский реал", "100 Венгерских форинтов ", "1000 Вон Республики Корея"
  Data.s "10 Датских крон", "1 Доллар США", "1 Евро", "100 Индийских рупий", "100 Казахских тенге"
  Data.s "1 Канадский доллар", "100 Киргизских сомов", "10 Китайских юаней", "1 Латвийский лат"
  Data.s "1 Литовский лит", "10 Молдавских леев", "10 Новых румынских леев", "10 Новых туркменских манатов"
  Data.s "10 Норвежских крон", "1 Польский злотый", "1 СДР (специальные права заимствования)", "1 Сингапурский доллар"
  Data.s "10 Таджикских сомони", "1 Турецкая лира", "1000 Узбекских сумов", "10 Украинских гривен"
  Data.s "1 Фунт стерлингов Соединенного королевства", "10 Чешских крон", "10 Шведских крон", "1 Швейцарский франк"
  Data.s "10 Южноафриканских рэндов", "100 Японских иен"
EndDataSection

0

Пётр · Поделиться**163**27.06.2011 15:40:42

Вот рабочий вариант.
Регулярные выражения не использовал, потому что и без них легко реализовывается.

Код:

Procedure.l DownloadToMem(URL.s, *lpRam, ramsize.l) 
  Protected agent.s, hInet.l, hData.l, Bytes.l 
  
  agent.s = "IE 6.0" 
  hInet.l = InternetOpen_ ( @agent.s,0,0,0,0 ) 
  hData.l = InternetOpenUrl_ ( hInet, @URL.s, "", 0, $8000000, 0 ) 
  
  If hData > 0 : InternetReadFile_ ( hData, *lpRam, ramsize.l, @Bytes.l ) : Else : Bytes = -1 : EndIf 
  
  InternetCloseHandle_ (hInet) 
  InternetCloseHandle_ (hFile) 
  InternetCloseHandle_ (hData) 
  
  ProcedureReturn Bytes.l 
EndProcedure 

Procedure.s UTF2Ansi(str$) 
   str_in$=str$: len=Len(str_in$)+5: str_tmp$=Space(len*4) 
   CP_IN=65001; #CP_UTF8=65001
   CP_OUT=1251 
   MultiByteToWideChar_(CP_IN,0,@str_in$,len,@str_tmp$,len) 
   WideCharToMultiByte_(CP_OUT,0,@str_tmp$,len,@str_in$,len,0,0) 
   ProcedureReturn str_in$ 
EndProcedure

Procedure.s Many_ru()
  Protected Result.s, *mem, Many.s
  Protected url.s, Bytes, Datas.s, html.s
  Protected Dim Result$(0), ManyExpression.s
  Protected Pos
  
  Result = "Ошибка"
  Datas = FormatDate("%dd.%mm.%yyyy",Date())
  url = "http://www.cbr.ru/currency_base/D_print.aspx?date_req="+Datas
  
  *mem = AllocateMemory(200000)
  If *mem
    Bytes = DownloadToMem(url, *mem, 200000)
    If Bytes
      html = UTF2Ansi(PeekS(*mem))
      If html<>""
        Result = "Центральный банк Российской Федерации установил следующие курсы иностранных валют к рублю Российской Федерации  на " + Datas + ":" + Chr(10)
        Restore Many_ru
        For i=1 To 35
          Read.s Many
          Pos = FindString(Many, " ", 1)
          ManyExpression = Right(Many, Len(Many)-Pos)

          ManyExpression+"</td>" + #CRLF$ + "<td align="+Chr(34)+"right"+Chr(34)+">"
          Pos1 = FindString(html, ManyExpression, 1)
          If Pos1>0
            Pos1+Len(ManyExpression)
            Pos2 = FindString(html,"</td>",Pos1)
            If Pos2>0
              Result + " "+Many+" = "+Mid(html, Pos1, Pos2-Pos1) +" руб.;"
            EndIf
          EndIf

        Next i
      EndIf
    EndIf
    FreeMemory(*mem)
  EndIf
  
  ProcedureReturn Result
EndProcedure



If OpenWindow(0, 0, 0, 322, 150, "EditorGadget", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  EditorGadget(0, 8, 8, 306, 133)
  SendMessage_(GadgetID(0),#EM_SETTARGETDEVICE, #Null, 0)
  SetGadgetText(0,Many_ru())
  Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
EndIf



DataSection
  Many_ru:
  Data.s "1 Австралийский доллар", "1 Азербайджанский манат", "1000 Армянских драмов", "10000 Белорусских рублей"
  Data.s "1 Болгарский лев", "1 Бразильский реал", "100 Венгерских форинтов ", "1000 Вон Республики Корея"
  Data.s "10 Датских крон", "1 Доллар США", "1 Евро", "100 Индийских рупий", "100 Казахских тенге"
  Data.s "1 Канадский доллар", "100 Киргизских сомов", "10 Китайских юаней", "1 Латвийский лат"
  Data.s "1 Литовский лит", "10 Молдавских леев", "10 Новых румынских леев", "10 Новых туркменских манатов"
  Data.s "10 Норвежских крон", "1 Польский злотый", "1 СДР (специальные права заимствования)", "1 Сингапурский доллар"
  Data.s "10 Таджикских сомони", "1 Турецкая лира", "1000 Узбекских сумов", "10 Украинских гривен"
  Data.s "1 Фунт стерлингов Соединенного королевства", "10 Чешских крон", "10 Шведских крон", "1 Швейцарский франк"
  Data.s "10 Южноафриканских рэндов", "100 Японских иен"
EndDataSection

+1

max · [1985-03-29]

Пётр написал(а):

А процедура Many_ru должна быть примерно такой

Спасибо.

Пётр написал(а):

Чет, не получается внятно расшифровать кириллицу с сайта!

Есть у кого-нибудь какие идеи? :dontknow:

0

Пётр · Поделиться**165**27.06.2011 16:13:35

max написал(а):

Есть у кого-нибудь какие идеи?

Выше выложил рабочий код - процедура UTF2Ansi преобразовывает кодировки.

0

max · [1985-03-29]

Пётр написал(а):

Выше выложил рабочий код

Спасибо. Не заметил.

0

max · [1985-03-29]

Попробовал на основе кода из поста 163 сделать курс валют для Украины. Выводится заголовок и все. Что не так?

Код:

Procedure.l DownloadToMem(URL.s, *lpRam, ramsize.l) 
  Protected agent.s, hInet.l, hData.l, Bytes.l 
  
  agent.s = "IE 6.0" 
  hInet.l = InternetOpen_ ( @agent.s,0,0,0,0 ) 
  hData.l = InternetOpenUrl_ ( hInet, @URL.s, "", 0, $8000000, 0 ) 
  
  If hData > 0 : InternetReadFile_ ( hData, *lpRam, ramsize.l, @Bytes.l ) : Else : Bytes = -1 : EndIf 
  
  InternetCloseHandle_ (hInet) 
  InternetCloseHandle_ (hFile) 
  InternetCloseHandle_ (hData) 
  
  ProcedureReturn Bytes.l 
EndProcedure 

Procedure.s UTF2Ansi(str$) 
   str_in$=str$: len=Len(str_in$)+5: str_tmp$=Space(len*4) 
   CP_IN=65001; #CP_UTF8=65001
   CP_OUT=1251 
   MultiByteToWideChar_(CP_IN,0,@str_in$,len,@str_tmp$,len) 
   WideCharToMultiByte_(CP_OUT,0,@str_tmp$,len,@str_in$,len,0,0) 
   ProcedureReturn str_in$ 
EndProcedure

Procedure.s Many_uk()
  Protected Result.s, *mem, Many.s
  Protected url.s, Bytes, Datas.s, html.s
  Protected Dim Result$(0), ManyExpression.s
  Protected Pos
  
  Result = "Помилка при розшифровці файлу"
  Datas = FormatDate("%dd.%mm.%yyyy",Date())
  url = "http://bank.gov.ua/Fin_ryn/OF_KURS/Currency/FindByDate.aspx?__EVENTARGUMENT=&__EVENTTARGET=&Text1="+Datas
  
  *mem = AllocateMemory(200000)
  If *mem
    Bytes = DownloadToMem(url, *mem, 200000)
    If Bytes
      html = UTF2Ansi(PeekS(*mem))
      If html<>""
        Result = "Національний банк України. Середній курс гривні до іноземних валют на " + Datas + " становить:" + Chr(10)
        Restore Many_uk
        For i=1 To 27
          Read.s Many
          Pos = FindString(Many, " ", 1)
          ManyExpression = Right(Many, Len(Many)-Pos)

          ManyExpression+"</td>" + #CRLF$ + "<td align="+Chr(34)+"right"+Chr(34)+">"
          Pos1 = FindString(html, ManyExpression, 1)
          If Pos1>0
            Pos1+Len(ManyExpression)
            Pos2 = FindString(html,"</td>",Pos1)
            If Pos2>0
              Result + " "+Many+" = "+Mid(html, Pos1, Pos2-Pos1) +" грн.;"
            EndIf
          EndIf

        Next i
      EndIf
    EndIf
    FreeMemory(*mem)
  EndIf
  
  ProcedureReturn Result
EndProcedure



If OpenWindow(0, 0, 0, 322, 150, "EditorGadget", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  EditorGadget(0, 8, 8, 163, 90)
  SendMessage_(GadgetID(0),#EM_SETTARGETDEVICE, #Null, 0)
  SetGadgetText(0,Many_uk())
  Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
EndIf



DataSection
  Many_uk:
  Data.s "100 австралійських доларів", "100 азербайджанських манатів", "100 англійських фунтів стерлінгів", "10 білоруських рублів"
  Data.s "100 датських крон", "100 доларів США", "100 ЄВРО ", "100 ісландських крон"
  Data.s "100 казахстанських тенге", "100 канадських доларів", "100 латвійських латів", "100 литовських літів", "100 молдовських леїв"
  Data.s "100 норвезьких крон", "100 польських злотих", "10 російських рублів", "100 сінгапурських доларів"
  Data.s "100 СПЗ", "100 турецьких лір", "100 туркменських манатів", "1000 угорських форинтів"
  Data.s "100 узбецьких сумів", "100 чеських крон", "100 шведських крон", "100 швейцарських франків"
  Data.s "100 юанів женьміньбі (Китай)", "1000 японських єн"
EndDataSection

Отредактировано max (27.06.2011 19:56:53)

0

Пётр · Поделиться**168**27.06.2011 20:48:29

Там сайт другой и поэтому метод парсинга html странички тоже отличается.

0

max · [1985-03-29]

И как теперь быть?

0

Пётр · Поделиться**170**27.06.2011 21:02:03

max написал(а):

И как теперь быть?

Просто открывается сайт в браузере и просматривается код страницы чтобы понять как из неё (странички) выудить требуемую информацию.

Так вроде работает:

Код:

Procedure.l DownloadToMem(URL.s, *lpRam, ramsize.l) 
  Protected agent.s, hInet.l, hData.l, Bytes.l 
  
  agent.s = "IE 6.0" 
  hInet.l = InternetOpen_ ( @agent.s,0,0,0,0 ) 
  hData.l = InternetOpenUrl_ ( hInet, @URL.s, "", 0, $8000000, 0 ) 
  
  If hData > 0 : InternetReadFile_ ( hData, *lpRam, ramsize.l, @Bytes.l ) : Else : Bytes = -1 : EndIf 
  
  InternetCloseHandle_ (hInet) 
  InternetCloseHandle_ (hFile) 
  InternetCloseHandle_ (hData) 
  
  ProcedureReturn Bytes.l 
EndProcedure 

Procedure.s UTF2Ansi(str$) 
   str_in$=str$: len=Len(str_in$)+5: str_tmp$=Space(len*4) 
   CP_IN=65001; #CP_UTF8=65001
   CP_OUT=1251 
   MultiByteToWideChar_(CP_IN,0,@str_in$,len,@str_tmp$,len) 
   WideCharToMultiByte_(CP_OUT,0,@str_tmp$,len,@str_in$,len,0,0) 
   ProcedureReturn str_in$ 
EndProcedure

Procedure.s Many_uk()
  Protected Result.s, *mem, Many.s
  Protected url.s, Bytes, Datas.s, html.s
  Protected ManyExpression.s, Temp.s
  Protected Pos, Pos1, Pos2
  
  Result = "Помилка при розшифровці файлу"
  Datas = FormatDate("%dd.%mm.%yyyy",Date())
  url = "http://bank.gov.ua/Fin_ryn/OF_KURS/Currency/FindByDate.aspx?__EVENTARGUMENT=&__EVENTTARGET=&Text1="+Datas
  
  *mem = AllocateMemory(200000)
  If *mem
    Bytes = DownloadToMem(url, *mem, 200000)
    If Bytes
      html = UTF2Ansi(PeekS(*mem))
      If html<>""
        
        Pos = FindString(html, "<td>Офіційний курс</td>", 1)
        If Pos
          Pos1 = FindString(html, "</table>", Pos+Len("<td>Офіційний курс</td>"))
          If Pos1
            
            html=Mid(html, Pos, Pos1-Pos)

            Result = "Національний банк України. Середній курс гривні до іноземних валют на " + Datas + " становить:" + Chr(10)
            Restore Many_uk
            For i=1 To 27
              Read.s Many
              Pos = FindString(Many, " ", 1)
              ManyExpression = Right(Many, Len(Many)-Pos)
              ManyExpression + "</td>"
              Pos1 = FindString(html, ManyExpression, 1)
              If Pos1>0
                Pos1+Len(ManyExpression)
                Pos2 = FindString(html,"</td>",Pos1)
                If Pos2>0
                  
                  Temp.s=Mid(html, Pos1, Pos2-Pos1)
                  Pos = FindString(ReverseString(Temp),">", 1)
                  If Pos>0
                    Result + " "+Many+" = "+Mid(Temp, Len(Temp)-Pos+2)+" грн.;"
                  EndIf
                  
                EndIf
              EndIf
            Next i
            
          EndIf
        EndIf
      EndIf
    EndIf
    FreeMemory(*mem)
  EndIf
  
  ProcedureReturn Result
EndProcedure



If OpenWindow(0, 0, 0, 322, 150, "EditorGadget", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  EditorGadget(0, 8, 8, 163, 90)
  SendMessage_(GadgetID(0),#EM_SETTARGETDEVICE, #Null, 0)
  SetGadgetText(0,Many_uk())
  Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
EndIf



DataSection
  Many_uk:
  Data.s "100 австралійських доларів", "100 азербайджанських манатів", "100 англійських фунтів стерлінгів", "10 білоруських рублів"
  Data.s "100 датських крон", "100 доларів США", "100 ЄВРО ", "100 ісландських крон"
  Data.s "100 казахстанських тенге", "100 канадських доларів", "100 латвійських латів", "100 литовських літів", "100 молдовських леїв"
  Data.s "100 норвезьких крон", "100 польських злотих", "10 російських рублів", "100 сінгапурських доларів"
  Data.s "100 СПЗ", "100 турецьких лір", "100 туркменських манатів", "1000 угорських форинтів"
  Data.s "100 узбецьких сумів", "100 чеських крон", "100 шведських крон", "100 швейцарських франків"
  Data.s "100 юанів женьміньбі (Китай)", "1000 японських єн"
EndDataSection

0

max · [1985-03-29]

Пётр написал(а):

Так вроде работает

Точно работает.

0

max · [1985-03-29]

Осталось самое "простое": соеденить их и при изменении ComboBoxGadget выбирать соответствующий сайт.

0

Пётр · Поделиться**173**27.06.2011 21:16:10

max написал(а):

самое "простое"

Почему в кавычках?

0

max · [1985-03-29]

Пётр написал(а):

Почему в кавычках?

Написал, не посмотрев толком код.
Вот что у меня получилось:

Код:

Procedure.l DownloadToMem(URL.s, *lpRam, ramsize.l) 
  Protected agent.s, hInet.l, hData.l, Bytes.l 
  
  agent.s = "IE 6.0" 
  hInet.l = InternetOpen_ ( @agent.s,0,0,0,0 ) 
  hData.l = InternetOpenUrl_ ( hInet, @URL.s, "", 0, $8000000, 0 ) 
  
  If hData > 0 : InternetReadFile_ ( hData, *lpRam, ramsize.l, @Bytes.l ) : Else : Bytes = -1 : EndIf 
  
  InternetCloseHandle_ (hInet) 
  InternetCloseHandle_ (hFile) 
  InternetCloseHandle_ (hData) 
  
  ProcedureReturn Bytes.l 
EndProcedure 

Procedure.s UTF2Ansi(str$) 
   str_in$=str$: len=Len(str_in$)+5: str_tmp$=Space(len*4) 
   CP_IN=65001; #CP_UTF8=65001
   CP_OUT=1251 
   MultiByteToWideChar_(CP_IN,0,@str_in$,len,@str_tmp$,len) 
   WideCharToMultiByte_(CP_OUT,0,@str_tmp$,len,@str_in$,len,0,0) 
   ProcedureReturn str_in$ 
EndProcedure

Procedure.s Many_ru()
  Protected Result.s, *mem, Many.s
  Protected url.s, Bytes, Datas.s, html.s
  Protected Dim Result$(0), ManyExpression.s
  Protected Pos
  
  Result = "Ошибка"
  Datas = FormatDate("%dd.%mm.%yyyy",Date())
  url = "http://www.cbr.ru/currency_base/D_print.aspx?date_req="+Datas
  
  *mem = AllocateMemory(200000)
  If *mem
    Bytes = DownloadToMem(url, *mem, 200000)
    If Bytes
      html = UTF2Ansi(PeekS(*mem))
      If html<>""
        Result = "Центральный банк Российской Федерации установил следующие курсы иностранных валют к рублю Российской Федерации  на " + Datas + ":" + Chr(10)
        Restore Many_ru
        For i=1 To 35
          Read.s Many
          Pos = FindString(Many, " ", 1)
          ManyExpression = Right(Many, Len(Many)-Pos)

          ManyExpression+"</td>" + #CRLF$ + "<td align="+Chr(34)+"right"+Chr(34)+">"
          Pos1 = FindString(html, ManyExpression, 1)
          If Pos1>0
            Pos1+Len(ManyExpression)
            Pos2 = FindString(html,"</td>",Pos1)
            If Pos2>0
              Result + " "+Many+" = "+Mid(html, Pos1, Pos2-Pos1) +" руб.;"
            EndIf
          EndIf

        Next i
      EndIf
    EndIf
    FreeMemory(*mem)
  EndIf
  
  ProcedureReturn Result
EndProcedure

Procedure.s Many_uk()
  Protected Result.s, *mem, Many.s
  Protected url.s, Bytes, Datas.s, html.s
  Protected ManyExpression.s, Temp.s
  Protected Pos, Pos1, Pos2
  
  Result = "Помилка при розшифровці файлу"
  Datas = FormatDate("%dd.%mm.%yyyy",Date())
  url = "http://bank.gov.ua/Fin_ryn/OF_KURS/Currency/FindByDate.aspx?__EVENTARGUMENT=&__EVENTTARGET=&Text1="+Datas
  
  *mem = AllocateMemory(200000)
  If *mem
    Bytes = DownloadToMem(url, *mem, 200000)
    If Bytes
      html = UTF2Ansi(PeekS(*mem))
      If html<>""
        
        Pos = FindString(html, "<td>Офіційний курс</td>", 1)
        If Pos
          Pos1 = FindString(html, "</table>", Pos+Len("<td>Офіційний курс</td>"))
          If Pos1
            
            html=Mid(html, Pos, Pos1-Pos)

            Result = "Національний банк України. Середній курс гривні до іноземних валют на " + Datas + " становить:" + Chr(10)
            Restore Many_uk
            For i=1 To 27
              Read.s Many
              Pos = FindString(Many, " ", 1)
              ManyExpression = Right(Many, Len(Many)-Pos)
              ManyExpression + "</td>"
              Pos1 = FindString(html, ManyExpression, 1)
              If Pos1>0
                Pos1+Len(ManyExpression)
                Pos2 = FindString(html,"</td>",Pos1)
                If Pos2>0
                  
                  Temp.s=Mid(html, Pos1, Pos2-Pos1)
                  Pos = FindString(ReverseString(Temp),">", 1)
                  If Pos>0
                    Result + " "+Many+" = "+Mid(Temp, Len(Temp)-Pos+2)+" грн.;"
                  EndIf
                  
                EndIf
              EndIf
            Next i
            
          EndIf
        EndIf
      EndIf
    EndIf
    FreeMemory(*mem)
  EndIf
  
  ProcedureReturn Result
EndProcedure



If OpenWindow(0, 0, 0, 400, 150, "EditorGadget", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  EditorGadget(0, 8, 8, 200, 90)
  SendMessage_(GadgetID(0),#EM_SETTARGETDEVICE, #Null, 0)
  SetGadgetText(0,Many_uk())
  ComboBoxGadget(30, 220, 28, 142, 21)
AddGadgetItem(30, -1, "Украина")
AddGadgetItem(30, -1, "Россия")
  
  ;{----------События компонентов----------
  If Event=#PB_Event_Gadget
    
    Select EventGadget()
         Case 30
        If EventType()=1
          Select GetGadgetState(30)
            Case 0

            Case 1

          EndSelect
          EndIf
        
    EndSelect
    
    
    
  EndIf 
  ;}-------------------------------------
  
  Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
EndIf



DataSection
  Many_ru:
  Data.s "1 Австралийский доллар", "1 Азербайджанский манат", "1000 Армянских драмов", "10000 Белорусских рублей"
  Data.s "1 Болгарский лев", "1 Бразильский реал", "100 Венгерских форинтов ", "1000 Вон Республики Корея"
  Data.s "10 Датских крон", "1 Доллар США", "1 Евро", "100 Индийских рупий", "100 Казахских тенге"
  Data.s "1 Канадский доллар", "100 Киргизских сомов", "10 Китайских юаней", "1 Латвийский лат"
  Data.s "1 Литовский лит", "10 Молдавских леев", "10 Новых румынских леев", "10 Новых туркменских манатов"
  Data.s "10 Норвежских крон", "1 Польский злотый", "1 СДР (специальные права заимствования)", "1 Сингапурский доллар"
  Data.s "10 Таджикских сомони", "1 Турецкая лира", "1000 Узбекских сумов", "10 Украинских гривен"
  Data.s "1 Фунт стерлингов Соединенного королевства", "10 Чешских крон", "10 Шведских крон", "1 Швейцарский франк"
  Data.s "10 Южноафриканских рэндов", "100 Японских иен"
  Many_uk:
  Data.s "100 австралійських доларів", "100 азербайджанських манатів", "100 англійських фунтів стерлінгів", "10 білоруських рублів"
  Data.s "100 датських крон", "100 доларів США", "100 ЄВРО ", "100 ісландських крон"
  Data.s "100 казахстанських тенге", "100 канадських доларів", "100 латвійських латів", "100 литовських літів", "100 молдовських леїв"
  Data.s "100 норвезьких крон", "100 польських злотих", "10 російських рублів", "100 сінгапурських доларів"
  Data.s "100 СПЗ", "100 турецьких лір", "100 туркменських манатів", "1000 угорських форинтів"
  Data.s "100 узбецьких сумів", "100 чеських крон", "100 шведських крон", "100 швейцарських франків"
  Data.s "100 юанів женьміньбі (Китай)", "1000 японських єн"
EndDataSection

Как я понял что-бы все работало, надо в SetGadgetText(0,Many_uk()) при выборе другой страны менять uk на ru и наоборот.

Отредактировано max (27.06.2011 21:31:25)

0

Пётр · Поделиться**175**27.06.2011 21:48:04

max написал(а):

Как я понял что-бы все работало, надо в SetGadgetText(0,Many_uk()) при выборе другой страны менять uk на ru и наоборот.

Да.

Код:

Procedure.l DownloadToMem(URL.s, *lpRam, ramsize.l) 
  Protected agent.s, hInet.l, hData.l, Bytes.l 
  
  agent.s = "IE 6.0" 
  hInet.l = InternetOpen_( @agent.s,0,0,0,0 ) 
  hData.l = InternetOpenUrl_( hInet, @URL.s, "", 0, $8000000, 0 ) 
  
  If hData > 0 : InternetReadFile_ ( hData, *lpRam, ramsize.l, @Bytes.l ) : Else : Bytes = -1 : EndIf 
  
  InternetCloseHandle_(hInet) 
  ;InternetCloseHandle_(hFile) 
  InternetCloseHandle_(hData) 
  
  ProcedureReturn Bytes.l 
EndProcedure 

Procedure.s UTF2Ansi(str$) 
  str_in$=str$: len=Len(str_in$)+5: str_tmp$=Space(len*4) 
  CP_IN=65001; #CP_UTF8=65001
  CP_OUT=1251 
  MultiByteToWideChar_(CP_IN,0,@str_in$,len,@str_tmp$,len) 
  WideCharToMultiByte_(CP_OUT,0,@str_tmp$,len,@str_in$,len,0,0) 
  ProcedureReturn str_in$ 
EndProcedure

Procedure.s Many_ru()
  Protected Result.s, *mem, Many.s
  Protected url.s, Bytes, Datas.s, html.s
  Protected Dim Result$(0), ManyExpression.s
  Protected Pos
  
  Result = "Ошибка"
  Datas = FormatDate("%dd.%mm.%yyyy",Date())
  url = "http://www.cbr.ru/currency_base/D_print.aspx?date_req="+Datas
  
  *mem = AllocateMemory(200000)
  If *mem
    Bytes = DownloadToMem(url, *mem, 200000)
    If Bytes
      html = UTF2Ansi(PeekS(*mem))
      If html<>""
        Result = "Центральный банк Российской Федерации установил следующие курсы иностранных валют к рублю Российской Федерации  на " + Datas + ":" + Chr(10)
        Restore Many_ru
        For i=1 To 35
          Read.s Many
          Pos = FindString(Many, " ", 1)
          ManyExpression = Right(Many, Len(Many)-Pos)
          
          ManyExpression+"</td>" + #CRLF$ + "<td align="+Chr(34)+"right"+Chr(34)+">"
          Pos1 = FindString(html, ManyExpression, 1)
          If Pos1>0
            Pos1+Len(ManyExpression)
            Pos2 = FindString(html,"</td>",Pos1)
            If Pos2>0
              Result + " "+Many+" = "+Mid(html, Pos1, Pos2-Pos1) +" руб.;"
            EndIf
          EndIf
          
        Next i
      EndIf
    EndIf
    FreeMemory(*mem)
  EndIf
  
  ProcedureReturn Result
EndProcedure

Procedure.s Many_uk()
  Protected Result.s, *mem, Many.s
  Protected url.s, Bytes, Datas.s, html.s
  Protected ManyExpression.s, Temp.s
  Protected Pos, Pos1, Pos2
  
  Result = "Помилка при розшифровці файлу"
  Datas = FormatDate("%dd.%mm.%yyyy",Date())
  url = "http://bank.gov.ua/Fin_ryn/OF_KURS/Currency/FindByDate.aspx?__EVENTARGUMENT=&__EVENTTARGET=&Text1="+Datas
  
  *mem = AllocateMemory(200000)
  If *mem
    Bytes = DownloadToMem(url, *mem, 200000)
    If Bytes
      html = UTF2Ansi(PeekS(*mem))
      If html<>""
        
        Pos = FindString(html, "<td>Офіційний курс</td>", 1)
        If Pos
          Pos1 = FindString(html, "</table>", Pos+Len("<td>Офіційний курс</td>"))
          If Pos1
            
            html=Mid(html, Pos, Pos1-Pos)
            
            Result = "Національний банк України. Середній курс гривні до іноземних валют на " + Datas + " становить:" + Chr(10)
            Restore Many_uk
            For i=1 To 27
              Read.s Many
              Pos = FindString(Many, " ", 1)
              ManyExpression = Right(Many, Len(Many)-Pos)
              ManyExpression + "</td>"
              Pos1 = FindString(html, ManyExpression, 1)
              If Pos1>0
                Pos1+Len(ManyExpression)
                Pos2 = FindString(html,"</td>",Pos1)
                If Pos2>0
                  
                  Temp.s=Mid(html, Pos1, Pos2-Pos1)
                  Pos = FindString(ReverseString(Temp),">", 1)
                  If Pos>0
                    Result + " "+Many+" = "+Mid(Temp, Len(Temp)-Pos+2)+" грн.;"
                  EndIf
                  
                EndIf
              EndIf
            Next i
            
          EndIf
        EndIf
      EndIf
    EndIf
    FreeMemory(*mem)
  EndIf
  
  ProcedureReturn Result
EndProcedure



If OpenWindow(0, 0, 0, 400, 150, "EditorGadget", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  EditorGadget(0, 8, 8, 200, 90)
  SendMessage_(GadgetID(0),#EM_SETTARGETDEVICE, #Null, 0)
  SetGadgetText(0,Many_uk())
  ComboBoxGadget(30, 220, 28, 142, 21)
  AddGadgetItem(30, -1, "Украина")
  AddGadgetItem(30, -1, "Россия")
  SetGadgetState(30,0)
  
  Repeat
   Event=WaitWindowEvent()
  ;{----------События компонентов----------
  If Event=#PB_Event_Gadget
    
    Select EventGadget()
      Case 30
        If EventType()=1
          Select GetGadgetState(30)
            Case 0
              SetGadgetText(0,Many_uk())
            Case 1
              SetGadgetText(0,Many_ru())
          EndSelect
        EndIf
        
    EndSelect
    
    
    
  EndIf 
  ;}-------------------------------------
  
    Until Event = #PB_Event_CloseWindow
EndIf



DataSection
  Many_ru:
  Data.s "1 Австралийский доллар", "1 Азербайджанский манат", "1000 Армянских драмов", "10000 Белорусских рублей"
  Data.s "1 Болгарский лев", "1 Бразильский реал", "100 Венгерских форинтов ", "1000 Вон Республики Корея"
  Data.s "10 Датских крон", "1 Доллар США", "1 Евро", "100 Индийских рупий", "100 Казахских тенге"
  Data.s "1 Канадский доллар", "100 Киргизских сомов", "10 Китайских юаней", "1 Латвийский лат"
  Data.s "1 Литовский лит", "10 Молдавских леев", "10 Новых румынских леев", "10 Новых туркменских манатов"
  Data.s "10 Норвежских крон", "1 Польский злотый", "1 СДР (специальные права заимствования)", "1 Сингапурский доллар"
  Data.s "10 Таджикских сомони", "1 Турецкая лира", "1000 Узбекских сумов", "10 Украинских гривен"
  Data.s "1 Фунт стерлингов Соединенного королевства", "10 Чешских крон", "10 Шведских крон", "1 Швейцарский франк"
  Data.s "10 Южноафриканских рэндов", "100 Японских иен"
  Many_uk:
  Data.s "100 австралійських доларів", "100 азербайджанських манатів", "100 англійських фунтів стерлінгів", "10 білоруських рублів"
  Data.s "100 датських крон", "100 доларів США", "100 ЄВРО ", "100 ісландських крон"
  Data.s "100 казахстанських тенге", "100 канадських доларів", "100 латвійських латів", "100 литовських літів", "100 молдовських леїв"
  Data.s "100 норвезьких крон", "100 польських злотих", "10 російських рублів", "100 сінгапурських доларів"
  Data.s "100 СПЗ", "100 турецьких лір", "100 туркменських манатів", "1000 угорських форинтів"
  Data.s "100 узбецьких сумів", "100 чеських крон", "100 шведських крон", "100 швейцарських франків"
  Data.s "100 юанів женьміньбі (Китай)", "1000 японських єн"
EndDataSection

0

max · [1985-03-29]

Спасибо. Я так пробовал, только забыл добавить SetGadgetState(30,0), и не заработало.

0

max · [1985-03-29]

Привет.
Попытался добавить "авторов" с помощью процедуры ProgramItit_Thread(*x). Судя по коду, файл добавляется строкой

Код:

*mem = UnPak(?GismeteoCodSity_pak)

,преобразуется, а затем создается

Код:

AddGadgetItem(#ComboBox_0, x,String)

с текстом. Возникло пара вопросов:
1. как можно добавить несколько файлов?
2. как сделать, чтобы при смене языка выбирался свой pak-файл?
Архив с файлами.

0

Пётр · Поделиться**178**28.06.2011 18:57:46

max написал(а):

Попытался добавить "авторов" с помощью процедуры ProgramItit_Thread(*x).

Текста так много что его нужно упаковывать?

max написал(а):

Судя по коду, файл добавляется строкой

Нет, это распаковка сжатого файла, а файл был добавлен в ДатаСекцию.

Код:

  GismeteoCodSity_pak:
  IncludeBinary "GismeteoCodSity.pak"

Процедуре нужно передать указатель на первый байт сжатых данных, и она (процедура) вернет указатель на начало в памяти распакованных данных. Есть это текст, то его можно прочитать из памяти функцией PeekS.
Память нужно обязательно освободить функцией FreeMemory когда она уже не нужна.

max написал(а):

1. как можно добавить несколько файлов?

Или с диска загружать (придется за прогой тащить все эти файлы) или поместить в ДатаСекцию к уже имеющимся.

max написал(а):

2. как сделать, чтобы при смене языка выбирался свой pak-файл?

Если он на диске, то загрузить с диска, а есть в ДатаСекции, то прочитать от туда.

0

max · [1985-03-29]

Добавил время.

Пётр написал(а):

Текста так много что его нужно упаковывать?

Их будет два.

Пётр написал(а):

придется за прогой тащить все эти файлы

Вот этого и не хочется.
Над остальным подумаем.

0

Пётр · Поделиться**180**28.06.2011 19:43:04

max написал(а):

Их будет два.

А в килобайтах (или символах) сколько?
Просто в окне "О программе" обычно не много текста и нет необходимости его упаковывать.

0

PureBasic - форум

Меню навигации

Пользовательские ссылки

Информация о пользователе

Светодиодная матрица - МОДЖЕТ (антигаджет) на Пурике

Сообщений 151 страница 180 из 446

Поделиться15124.06.2011 00:26:14

Поделиться15224.06.2011 15:27:00

Поделиться15324.06.2011 15:45:48

Поделиться15424.06.2011 15:55:28

Поделиться15524.06.2011 16:37:09

Поделиться15626.06.2011 21:01:58

Поделиться15726.06.2011 21:32:52

Поделиться15826.06.2011 21:45:54

Поделиться15926.06.2011 21:52:23

Поделиться16026.06.2011 22:15:34

Поделиться16126.06.2011 22:17:51

Поделиться16226.06.2011 23:52:45

Поделиться16327.06.2011 15:40:42

Поделиться16427.06.2011 16:06:02

Поделиться16527.06.2011 16:13:35

Поделиться16627.06.2011 16:25:53

Поделиться16727.06.2011 19:53:45

Поделиться16827.06.2011 20:48:29

Поделиться16927.06.2011 20:54:53

Поделиться17027.06.2011 21:02:03

Поделиться17127.06.2011 21:05:10

Поделиться17227.06.2011 21:08:57

Поделиться17327.06.2011 21:16:10

Поделиться17427.06.2011 21:30:28

Поделиться17527.06.2011 21:48:04

Поделиться17627.06.2011 21:55:04

Поделиться17728.06.2011 18:23:11

Поделиться17828.06.2011 18:57:46

Поделиться17928.06.2011 19:25:33

Поделиться18028.06.2011 19:43:04

Похожие темы