[ Delphi / Pascal ] — начинающим: задаем вопросы (архивная - 2015)

Discussion in 'С/С++, C#, Rust, Swift, Go, Java, Perl, Ruby' started by banned, 6 May 2007.

Thread Status:
Not open for further replies.
  1. shadowrun

    shadowrun Banned

    Joined:
    29 Aug 2010
    Messages:
    842
    Likes Received:
    170
    Reputations:
    84
    А я посоветую внимательней читать мои посты. Winapi - это 2 модуля: Windows и ShellApi, а в вашем примере используются типы модуля Messages. По вышеуказанному примеру все работает, а вот в моем случае - сразу выполняется код, а после его выполнения окошко закрывается...
     
  2. alexey-m

    alexey-m Elder - Старейшина

    Joined:
    15 Jul 2009
    Messages:
    518
    Likes Received:
    100
    Reputations:
    37
    shadowrun, спасибо за разъяснения, что такое winapi...
    пардонте, если не увидели разницу в коде, чесно слово я не виноват
    ps: дело не в названии и числе используемых модулей, а в понимании правил выборки и обработки очереди сообщений
     
  3. shadowrun

    shadowrun Banned

    Joined:
    29 Aug 2010
    Messages:
    842
    Likes Received:
    170
    Reputations:
    84
    Привет!
    Ребята, как реализовать подобие StayOnTop на winapi. Делаю примерно следующее:
    в событии WM_TIMER SetWindowPos(), но на некоторых машинас с вин 7 не срабатывает, не могу понять почему.
     
  4. herfleisch

    herfleisch Elder - Старейшина

    Joined:
    7 Jan 2009
    Messages:
    579
    Likes Received:
    203
    Reputations:
    13
    А что именно ты устанавливаешь в SetWindowPos()?
     
  5. shadowrun

    shadowrun Banned

    Joined:
    29 Aug 2010
    Messages:
    842
    Likes Received:
    170
    Reputations:
    84
    Code:
    SetWindowPos(hwndMain,HWND_TOPMOST,0,0,getsystemmetrics(0),getsystemmetrics(0),0);
    На некоторых работает, на некоторых нет :confused:
     
  6. po[w]er

    po[w]er Banned

    Joined:
    1 Oct 2012
    Messages:
    57
    Likes Received:
    0
    Reputations:
    0
    Стучи в PM, помогу решить проблему. Если я верно понял суть её.
     
  7. shadowrun

    shadowrun Banned

    Joined:
    29 Aug 2010
    Messages:
    842
    Likes Received:
    170
    Reputations:
    84
    Проблему решил подстановкой следующих параметров:
    Code:
    SetWindowPos(hwndMain,HWND_TOPMOST,0,0,GetSystemMetrics(0),GetSystemMetrics(0),SWP_SHOWWINDOW);
     
  8. po[w]er

    po[w]er Banned

    Joined:
    1 Oct 2012
    Messages:
    57
    Likes Received:
    0
    Reputations:
    0
    неверно понял твою проблему)
     
  9. cardons

    cardons Elder - Старейшина

    Joined:
    19 Jul 2005
    Messages:
    778
    Likes Received:
    324
    Reputations:
    83
    Подскажите как в IdHttpServer добавить в ответе сервера Header ?
    А имеено "Access-Control-Allow-Origin: *".
    То есть чтобы получилось когда к нам на сервер стучаться сервер в Header ответа прописывал "Access-Control-Allow-Origin: *"


    P.S. Задача решена. Малоли кому понадобиться.

    AResponseInfo.CustomHeaders.Values['Access-Control-Allow-Origin'] := '*';
     
    #9349 cardons, 23 Dec 2012
    Last edited: 23 Dec 2012
  10. Protocoler

    Protocoler Elder - Старейшина

    Joined:
    10 Oct 2012
    Messages:
    51
    Likes Received:
    54
    Reputations:
    81
    Есть программа, в которой бьёт ошибку
    list of index out or bounds (9) !


    Есть код :
    Code:
     v:=0;
      GotoLabel:
      if v=1 then
      begin
      XML:=XML+inttostr(v);
      end;
      if pos('<a href="/profile/',XML)>0 then
      for  t:=0 to v do
      begin
      accounts.Add(Copy(XML,pos('<a href="/profile/',XML)+18,pos('/"',XML)-2));
      k:='<a href="/profile/';
      stringreplace(XML,k+accounts.strings[p],'-------',[rfReplaceAll, rfIgnoreCase]);
     { inc(i);  }
      inc(p);
      inc(v);
      if v=9 then
      begin
      Goto metka;
      end;
      Goto GotoLabel;
       end
      else
      metka:
      if accounts.count>0 then
      begin
      ShowMessage('Данные собраны, проводится рассылка');
      end
       else
      ShowMessage('По данному запросу ничего не найдено');
    
    В зависимости от того на какое число я поменяю v в строчке if v=9 then
    меняется ошибка. Например если поставлю 11 то ошибка будет list of index out or bounds (11) !

    При просмотре через дебаггер построчно, код обрубается на строчке:

    Code:
    for l:=0 to ((accounts.count-1)and(ID.count-1)) do
    относится к коду :
    Code:
    for l:=0 to ((accounts.count-1)and(ID.count-1)) do
     begin
     idhttp1.Post('http://*******/messenger.php?user_id='+ID[g], Message);
      {inc(g);}
     { Выводим в Лог }
      memo2.Lines.Add('Сообщение отослано: '+accounts[r]);
     {inc(r); }
     g:=g+1;
     r:=r+1;
     end;
    
    ID и accounts это TStringList. g и r равны 0


    Помогите исправить ошибку пожалуйста
     
  11. muip

    muip New Member

    Joined:
    1 Sep 2011
    Messages:
    45
    Likes Received:
    4
    Reputations:
    0
    Ты обращаешься к несуществующей строке. При обращении к ней нужно собственно проверять существует ли она.

    пример:

    if p<accounts.count then accounts[p] ..........
     
  12. cardons

    cardons Elder - Старейшина

    Joined:
    19 Jul 2005
    Messages:
    778
    Likes Received:
    324
    Reputations:
    83
    Подскажите почему в Jpeg пусто?

    Хотя в LoadStream данные существуют.

    Code:
    procedure TGetIdol.Execute;
    var
      CurUrl:Integer;
      HTTP: TIdHTTP;
      LoadStream : TMemoryStream;
      Jpeg : TJPEGImage;
      response : string;
    begin
    
      while WorkThreadGetIdol do
        begin
    
          CS.Enter;
          Inc(CurrentCaptcha);
    
          if (CurrentCaptcha < CountCapthaGet) then CurUrl := CurrentCaptcha else
          begin
            WorkThreadGetIdol := False;
          end;
           
          CS.Leave;
    
         if WorkThreadGetIdol then
          begin
            HTTP:=TIdHTTP.create;
            LoadStream := TMemoryStream.Create;
            Jpeg := TJPEGImage.Create;
    
            HTTP.AllowCookies := True;
            HTTP.HandleRedirects:=false;
    
            HTTP.Request.UserAgent := UserAgent;
            HTTP.Request.CustomHeaders.Add('Cookie: ' + CookieAcc);
            HTTP.Get('http://tmgame.ru/reg/image.php', LoadStream);
    
            if (LoadStream.Size <> 0) then
            begin
              Jpeg.LoadFromStream(LoadStream);
    
              response := CapthaTmRecognition(Jpeg);
    
              CS.Enter;
              //CapthaList.Add(response);
              Jpeg.SaveToFile(IntToStr(CurUrl) +'.jpg');
              CS.Leave;
            end;
    
            Jpeg.Free;  
            LoadStream.Free;
            HTTP.Free;
          end;
        end;
    
        Dec(Thread);
    
        if (Thread = 0) then
        begin
          CS.Free;
          ShowMessage(CapthaList.Text);
        end;
    end;
    
     
  13. accounts

    accounts New Member

    Joined:
    16 Oct 2011
    Messages:
    0
    Likes Received:
    4
    Reputations:
    10
    Перед Jpeg.LoadFromStream(LoadStream); вставьте LoadStream.Position := 0;
     
  14. FunOfGun

    FunOfGun Elder - Старейшина

    Joined:
    5 Sep 2012
    Messages:
    388
    Likes Received:
    72
    Reputations:
    124
    Суть дела: отправили на олимпиаду, а я делфи первый раз в жилни вижу. Синтаксис не проблема, освоил, а вот с функциями проблемка. Вобщем нельзя испольковать почти никакие модули, только SysUtils и турбопаскалевские функции. Есть какой-то хороший справочник с наиболее используемыми функциями и примерами? Заранее благодарен.
     
  15. Chrome~

    Chrome~ Elder - Старейшина

    Joined:
    13 Dec 2008
    Messages:
    936
    Likes Received:
    162
    Reputations:
    27
    Смотри здесь:
    http://www.delphisources.ru/pages/faq/faq_delphi_basics/navSysUtils.php.html
    А вообще не понятно, какие функции тебе на олимпиаде могут пригодиться. Может быть SetLength для массивов, но и то не факт. Лучше учи разнообразные алгоритмы (сортировка, поиск, работа с графами и т. д.).
     
    1 person likes this.
  16. extrimportal

    extrimportal Member

    Joined:
    13 Nov 2010
    Messages:
    102
    Likes Received:
    36
    Reputations:
    0
    Люди хелп. в делфи не силен. пишу авторизацию на сайте. дело в том что нужно отправить куки на страницу редиректа. делаю так:
    PHP:
    idhttp1.Request.CustomHeaders.Add('Cookie: HASH=bla1bla2bla3;path=/');
    IdHTTP1.Request.Host:='блабла.biz';
    LoginData.Add('login=бла');
    LoginData.Add('password=блабла');
    html := IdHTTP1.Post('http://блаблабла/',LoginData);
    авторизация проиходит. кукисы прописываются, идет редирект 302 на блабла/контент. и на них кукисы не передаются. много читал пробовал словить на
    PHP:
    if IdHTTP1.ResponseCode 302 
    idhttp1
    .Request.CustomHeaders.Add('Cookie: HASH=bla1bla2bla3;path=/');
    html := IdHTTP1.Post('http://блаблабла/',LoginData);
    все равно кукисы не добавляются хоть убейся!. хелп. как засунуть их на редиректую страницу???
     
  17. Rastamanka

    Rastamanka Elder - Старейшина

    Joined:
    26 Nov 2008
    Messages:
    429
    Likes Received:
    11
    Reputations:
    7
    Подскажите как в Delphi разборать JSon вот такого вида.

    Code:
    {"o":[{"i":2308997,"u":1689627,"o":{"c":2,"s":8,"r":{"g":0,"m":800,"u":0,"t":0}},"s":{"c":0,"s":0,"r":{"g":0,"m":0,"u":442,"t":0}},"t":1358106670000},{"i":2179733,"u":1581342,"o":{"c":3,"s":8,"r":{"g":0,"m":1200,"u":0,"t":0}},"s":{"c":0,"s":0,"r":{"g":0,"m":0,"u":900,"t":0}},"t":1358106669000},{"i":2308994,"u":1696693,"o":{"c":5,"s":8,"r":{"g":0,"m":2000,"u":0,"t":0}},"s":{"c":0,"s":0,"r":{"g":0,"m":0,"u":2000,"t":0}},"t":1358106666000},{"i":2308993,"u":299434,"o":{"c":1,"s":9.28,"r":{"g":0,"m":0,"u":800,"t":0}},"s":{"c":0,"s":0,"r":{"g":0,"m":0,"u":0,"t":1600}},"t":1358106665000},{"i":2308992,"u":315036,"o":{"c":3,"s":9.28,"r":{"g":0,"m":2520,"u":0,"t":0}},"s":{"c":0,"s":0,"r":{"g":0,"m":0,"u":1260,"t":0}},"t":1358106663000},{"i":2179732,"u":954494,"o":{"c":1,"s":9.6,"r":{"g":0,"m":800,"u":0,"t":0}},"s":{"c":0,"s":0,"r":{"g":0,"m":0,"u":0,"t":800}},"t":1358106661000}],"n":[{"v":2313,"s":"vk150975796","n":"Тетяна Гаврилюк","p":"http://cs411323.userapi.com/v411323796/6d4a/kMjIKDNHN_Q.jpg","r":1357215292456,"l":33,"a":"Луческ 4","m":{"x":2540,"y":1361},"c":8,"mc":0,"si":-1,"i":1689627,"g":0,"h":-1479096975},{"v":1596,"s":"vk106491283","n":"Timuchin Beket","p":"http://cs308319.userapi.com/v308319283/6152/onqu-37Ve8k.jpg","r":1357297231806,"l":33,"a":"AltynOrda","m":{"x":2546,"y":-675},"c":8,"mc":0,"si":-1,"i":1696693,"g":0,"h":-2095693314},{"v":22934,"s":"vk1731817","n":"Ольга Спириденко","p":"http://cs671.userapi.com/u1731817/a_e7bcd2a6.jpg","r":1351513487001,"l":51,"a":"HOUSE TARGARYEN","m":{"x":1131,"y":-444},"c":9.44,"x":44,"mc":0,"y":30,"si":-1,"i":299434,"g":0,"h":328810860},{"v":5962,"s":"vk8244732","n":"Марат Сафин","p":"http://cs307605.userapi.com/u8244732/a_0e7d8eb2.jpg","r":1351525216744,"l":46,"a":"Маратджан ","m":{"x":1150,"y":-374},"c":9.28,"mc":0,"si":-1,"i":315036,"g":0,"h":-473478544},{"v":1306,"s":"vk21226803","n":"Максим Косов","p":"http://cs11518.userapi.com/u21226803/a_912a0371.jpg","r":1356195792619,"l":36,"a":"***","m":{"x":-1280,"y":2475},"c":8,"mc":0,"si":-1,"i":1581342,"g":1,"h":-1775076958},{"v":6208,"s":"vk143381968","n":"Константин Ваганов","p":"http://cs10191.userapi.com/u143381968/a_60db1121.jpg","r":1353204535259,"l":43,"a":"Ниневия","m":{"x":-1675,"y":-1929},"c":9.6,"mc":0,"si":-1,"i":954494,"g":1,"h":-507717604}],"c":13}
    
    На php это так

    PHP:
                foreach ($obj->as $key)
                {
                    
    $i $key->i// какой то ID
                    
    $u $key->u// скорее всего зашифрованный USer
                    
    $c $key->o->c// колличество караванов необходимо
                    
    $s $key->o->s// время сколько будет идти

    }
    Не могу понять как это вытащить на Delphi.
     
  18. mironich

    mironich Elder - Старейшина

    Joined:
    27 Feb 2011
    Messages:
    733
    Likes Received:
    73
    Reputations:
    19
    http://www.json.org/
    В низу там список библиотек под разные ЯП, в Delphi с json намного нееудобней работать чем в php\python.
     
  19. alexey-m

    alexey-m Elder - Старейшина

    Joined:
    15 Jul 2009
    Messages:
    518
    Likes Received:
    100
    Reputations:
    37
    для delphi есть хорошая штука superobject для работы с json, и выгледеть это будет примерно так:
    Code:
    var
      FJson, json: ISuperObject;
      ....
    begin
    
      FJson:= SO('{......json string.....}');
      
      if Assigned(FJson) then begin
      
        json:= FJson.O['o'];
    	
    	for i:= 0 to json.AsArray.Length - 1 do begin
    
    	  xx:= json.AsArray[i].I['i'];		// integer
    	  xx:= json.AsArray[i].I['u'];
    	  xx:= json.AsArray[i].I['o.c'];
    	  xx:= json.AsArray[i].S['name'];	// string
    	  
    	end;
    
        json:= FJson.O['n'];
    	
    	for i:= 0 to json.AsArray.Length - 1 do begin
    
    	  xx:= json.AsArray[i].I['v'];
    	  xx:= json.AsArray[i].S['s'];
    	  xx:= json.AsArray[i].S['n'];	  
    	end;
    	
      end;  
    end;
     
  20. Rastamanka

    Rastamanka Elder - Старейшина

    Joined:
    26 Nov 2008
    Messages:
    429
    Likes Received:
    11
    Reputations:
    7
    Спасибо огромное за код.
    Но выводиться ошибка integer overflow.
    Использую Delphi 7.
    Попробовал указать тип не Integer а Int64.
    Ошибка не исчезла.

    Ругается с ссылкой на этот класс

    Code:
    class function TSuperAvlEntry.Hash(const k: SOString): Cardinal;
    var
      h: cardinal;
      i: Integer;
    begin
      h := 0;
    {$Q-}
      for i := 1 to Length(k) do
        h := h*129 + ord(k[i]) + $9e370001;
    {$Q+}
      Result := h;
    end;
    
    На строку h := h*129 + ord(k) + $9e370001;

    Из всего кода оставил только

    Code:
      FJson:= SO(response);
    Ошибка осталась )

    В response соответственно мой Json.
     
    #9360 Rastamanka, 14 Jan 2013
    Last edited: 14 Jan 2013
Thread Status:
Not open for further replies.