[ 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. =Zeus=

    =Zeus= Member

    Joined:
    10 Aug 2009
    Messages:
    213
    Likes Received:
    54
    Reputations:
    5
    2 BlackSite
    Смотря какя у тебя версия TICQClient. ICQ часто меняют протокол, и старые версии перестают работать. Скачай себе последнюю версию, помоему 1.35.
     
  2. AquaKlaster

    AquaKlaster Active Member

    Joined:
    9 Mar 2009
    Messages:
    0
    Likes Received:
    204
    Reputations:
    23
    На скрине ListView если не ошибаюсь.
     
  3. Almest

    Almest New Member

    Joined:
    19 Oct 2009
    Messages:
    2
    Likes Received:
    0
    Reputations:
    0
    Ребята помогите пожалуйста,нужна программа для разработка криптографической защиты данных. После запуска на выполнение программа должна по одному из алгоритмов, использующих генератор случайных чисел, зашифровать информацию, содержащуюся в указанном преподавателем файле, после чего записать файл под другим именем. Далее, по указанию пользователя, необходимо расшифровать записанный файл с помощью того же алгоритма.

    Очень нужна помощь,спасибо за внимание..
     
  4. Seregakz

    Seregakz New Member

    Joined:
    13 Jun 2009
    Messages:
    31
    Likes Received:
    1
    Reputations:
    0
    Nullsleep, отжигаеш))
    AquaKlaster, это СтрингГрид ибо в ячейках когда они заполнены отображается графика =/
    в ЛистВиев помоему нельзя в ячейку графику вставлять!!
     
  5. =Zeus=

    =Zeus= Member

    Joined:
    10 Aug 2009
    Messages:
    213
    Likes Received:
    54
    Reputations:
    5
    Прочитай внимательней назватие раздела: "ЗАДАЙ ВОПРОС". Где твой вопрос? Где то, что ты уже пытался сделать? Или ты думаешь зарегался на форуме и тебе в тот же день готовую программу напишуту? Делать всем болье нечего. Покажи, что ты пробовал и тебя поправят, если что не так. Тут екстасенсов нету. А если у тебя лабораторная то тебе в другой раздел. Ну а если софт нужно нормальный написать то это за деньги.
     
  6. BlackSite

    BlackSite Banned

    Joined:
    6 Feb 2009
    Messages:
    148
    Likes Received:
    100
    Reputations:
    0
    Может потому что я в этой графе вин uin не ввел?
    [​IMG]
     
  7. =Zeus=

    =Zeus= Member

    Joined:
    10 Aug 2009
    Messages:
    213
    Likes Received:
    54
    Reputations:
    5
    Вот кусок из моих сорцов:

    Code:
    uses icqworks;
    
    procedure TForm1.FormCreate(Sender: TObject);
    ...
    ICQClient1.UIN:=уин;
    ICQClient1.Password:='пас';
    ICQClient1.Login(0, false);
    ...
    
    
    procedure TForm1.BtnSendClick(Sender: TObject);
    begin
    ICQClient1.SendMessage(StrToInt(Edit1.Text), Memo1.Lines.Text);
    end;
    
    procedure TForm1.ICQClient1Error(Sender: TObject; ErrorType: TErrorType;
      ErrorMsg: String);
    begin
    MemoError.Lines.Add(ErrorMsg);
    end;
    Но есть одно "НО". Много раз логиниться с одного уина нельзя, его блочат на 10-20 мин.
     
    #4447 =Zeus=, 19 Oct 2009
    Last edited: 19 Oct 2009
  8. BlackSite

    BlackSite Banned

    Joined:
    6 Feb 2009
    Messages:
    148
    Likes Received:
    100
    Reputations:
    0
    Все проблему решил всем спасибо
     
  9. QweHack

    QweHack New Member

    Joined:
    7 Aug 2009
    Messages:
    1
    Likes Received:
    0
    Reputations:
    0
    Народ помогите решить задачку на Pascal.

    X ребят расположены по кругу. Начав счёт от первого удаляют каждого i-го, смыкая круг после каждого удаления. Определить номер последнего оставшегося.

    Заранее спасибо.
     
  10. bmp152

    bmp152 New Member

    Joined:
    25 May 2009
    Messages:
    8
    Likes Received:
    2
    Reputations:
    0
    хм, ясн, спасибо конечно, ток я тож 10.5.5 поставил обратно :)
    а у вас какая версия щас стоит? и чем вообще 10.5.7 отличается от 10.5.5 не в курсе случайно?
     
  11. Пуховой

    Joined:
    25 Nov 2007
    Messages:
    46
    Likes Received:
    37
    Reputations:
    0
    bmp152, если я не ошибаюсь, почти год уже прошел с выпуска 10.5.5. Соответственно - год доработок. Отличия и историю можно в svn-клиенте прочесть.

    У меня - 10.5.7
     
    1 person likes this.
  12. bmp152

    bmp152 New Member

    Joined:
    25 May 2009
    Messages:
    8
    Likes Received:
    2
    Reputations:
    0
    Ясн, значит на досуге буду снова ставить 7ю.
    У меня еще такой вопос ко всем: при постинге в мамбу никак не могу решить проблему с кодировкой кириллицы:
    Например постим в "обо мне":
    Если постить через браузер слово "Привет!" - сниффер показывает вот это:
    Code:
    s=afzXkx4HfgPnZSz1UIBPje57p2cqfwZm
    s_post=pqJfZufv5g3yKYybLlVNW0Nbugt7qT39
    tcurl=
    action=post
    noerror=0
    aboutme=Привет!
    
    При постинге через прогу:
    Code:
    s=wo2.Z47FJpmoAHLelvQj.1sQfbJ8fUEa
    s_post=Ygvvndc1lW368beAcf9pCtapQCwdEXJs
    tcurl=
    action=post
    noerror=0
    aboutme=Привет!
    
    При этом инфа в поле "обо мне" не появляется, если писать что-нибудь на английском - то все норм работает

    Пробовал так (нашел на каком-то форуме, сработало для "дамочка.ру", только там было наоборот - для браузера сниффер показывал норм. текст, для программы - кракозябры):
    Code:
    var
    ss: TStringStream;
      s,s2,s3,s4,s5,s6: UTF8String;
    
    ........
    
    http_client.Request.ContentType:='application/x-www-form-urlencoded';
        ss := TStringStream.Create('10');
        s  :=s;
        s2 :=s_post;
        s3 :='';
        s4 :='post';
        s5 :='0';
        s6 :='Привет!';
        ss.WriteString('s='+s+'&s_post='+s2 + '&tcurl=' + s3 + '&action=' + s4 + '&noerror=' + s5 + '&aboutme=' + s6);
        responseres.Text:=http_client.Post('http://mamba.ru/my/edit_aboutme.phtml',ss);
    
    - на выходе то же самое. Кто сталкивался, объясните пожалуйста в чем вообще проблема? по идее на мамбе utf-8 и клиент должен постить вроде как в ней же.
     
    #4452 bmp152, 21 Oct 2009
    Last edited: 21 Oct 2009
  13. НTL

    НTL Elder - Старейшина

    Joined:
    26 Jan 2008
    Messages:
    715
    Likes Received:
    205
    Reputations:
    -26
    Как секунды переделать в чч..чч(чч):мм:сс

    Проще говоря из 120 сделать 00:02:00
     
  14. Пуховой

    Joined:
    25 Nov 2007
    Messages:
    46
    Likes Received:
    37
    Reputations:
    0
    bmp152, и вы туда же... Ну да ладно.

    Ansitoutf8 ('Привет');
     
    #4454 Пуховой, 21 Oct 2009
    Last edited: 21 Oct 2009
    3 people like this.
  15. ZdezBilYa

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

    Joined:
    29 Aug 2008
    Messages:
    198
    Likes Received:
    75
    Reputations:
    19
    x:=120;
    sec:=x mod 60;
    x:=x div 60;
    min:=x mod 60;
    hou:=x div 60;
     
  16. bmp152

    bmp152 New Member

    Joined:
    25 May 2009
    Messages:
    8
    Likes Received:
    2
    Reputations:
    0
    Да я так, для общего развития)
    Большое спасибо, проблема решилась, оказывается все просто, вот только еще такой нюанс - мож кому пригодится:
    При постинге "а б в г д е ж з и й к л м н о п p с т у ф х ц ч ш щ ъ ы ь э ю я"

    Через браузер - получаем
    Code:
    Р° Р± РІ Рі Рґ Рµ Р¶ Р· Рё Р№ Рє Р» Рј РЅ Рѕ Рї СЂ СЃ С‚ Сѓ С„ С… С† С‡ С€ С‰ СЉ С‹ СЊ СЌ СЋ СЏ
    через idhttp -
    Code:
    Р° Р± РІ Рі Рґ Рµ Р¶ Р· Рё Р№ Рє Р» Рј РЅ Рѕ Рї С? СЃ С‚ Сѓ С„ С… С† С‡ С€ С‰ СЉ С‹ СЊ СЌ СЋ СЏ
    То есть буква "р" поидее должна заменяться на "СЂ", а она почемуто меняется на "С?", из-за этого весь текст не постится. Если русскую "р" заменить на аналог-латинскую, то все отлично работает.
     
  17. elimS2

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

    Joined:
    21 Mar 2008
    Messages:
    195
    Likes Received:
    159
    Reputations:
    11
    Всем привет. Пытаюсь авторизоваться вконтакте, не получаеться. Подскажите что делаю не верно:

    Code:
    
    procedure getcookie(st:string);
    var i,j:integer;
          ncookie:string;
    begin
     ncookie:='';
     for i:=1 to length(st) do
     if copy(st,i,10) = 'Set-Cookie' then
     begin
      for j := i+11 to length(st) do
      if st[j] = ';' then
      begin
       ncookie := ncookie + copy(st,i+11,j-i-10);
       break;
      end;
     end;
     if length(ncookie) > 50 then
     begin
     ncookie := 'Connection: Keep-Alive'+#13+'Cache-   Control: no-cache'+#13+'Cookie: remixchk=5'+'Cookie: '+ncookie;
      http.Request.CustomHeaders.Clear; 
      http.Request.CustomHeaders.Add(ncookie);
     end;
    end;
    
    procedure login(mail,pass:string);
    var reqs:tstringlist;resp,s:widestring;
    begin
     http:=TIdHTTP.Create(nil);
     coom:=TIdCookieManager.Create(http);
     http.AllowCookies:=true;
     http.CookieManager:=coom;
     http.HandleRedirects:=true;
     http.ProtocolVersion:=pv1_1;
     reqs:=tstringlist.Create;
     reqs.Add('email='+mail);
     reqs.Add('pass='+pass);
     reqs.Add('vk=');
     resp:=http.Post('http://login.vk.com/?act=login',reqs);
     Form1.Memo2.Text:=resp;
     delete(resp,1,pos('''s'' value=',resp)-1+length('''s'' value='''));
     s:=copy(resp,1,pos('''',resp)-1);
     Form1.Memo3.Text:=s;
     reqs.Clear;
     reqs.Add('op=slogin');
     reqs.Add('redirect=1');
     reqs.Add('expire=0');
     reqs.Add('to=');
     reqs.Add('s='+s);
     resp:=http.Post('http://vkontakte.ru/login.php',reqs);
     reqs:=http.Response.RawHeaders; 
     getcookie(reqs.Text);
    end;
    
    
     
  18. Пуховой

    Joined:
    25 Nov 2007
    Messages:
    46
    Likes Received:
    37
    Reputations:
    0
    bmp152, проблема с русской "р" в TidURI исправлена в 10.5.7 версии :)
     
  19. Пуховой

    Joined:
    25 Nov 2007
    Messages:
    46
    Likes Received:
    37
    Reputations:
    0
    Сама функция (определение и распознавание капчи, детект валида / невалида, детект невалид. прокси). В параметрах передаем аккаунт вида mail:pass, и tidhttp компонент. "antikey" - ваш ас-ключ.

    Code:
    function login_vk (account : string; http : tidhttp) : string;
    var
      s, imageurl, captcha : widestring;
      post : tstringlist;
      fs : Tmemorystream;
    begin
      post := tstringlist.Create;
      post.Add ('op=a_login_attempt');
      s := httpget (http, 'http://vkontakte.ru/');
      s := httppost (http, 'http://vkontakte.ru/login.php', post);
      post.Clear;
      if (countpos ('vklogin', s) = 0) and (countpos ('captcha_sid', s) = 0) then
      begin
        Result := 'falseproxy'; post.Free; exit;
      end;
      if countpos ('captcha_sid', s) <> 0 then
      begin
        fs := TmemoryStream.Create;
        imageurl := Extract (Extract (s, '"[\d]*"'), '[\d]*[\w]');
        post.Add ('op=a_login_attempt');
        post.Add ('captcha_sid=' + imageurl);
        try http.Get ('http://vkontakte.ru/captcha.php?s=1&sid=' + imageurl, fs); except end;
        captcha := recognize ('jpg', antikey, fs);
        while captcha = 'ERROR_NO_SLOT_AVAILABLE' do captcha := recognize ('jpg', antikey, fs);
        post.Add ('captcha_key=' + captcha);
        s := httppost (http, 'http://vkontakte.ru/login.php', post);
        fs.Free; post.Clear;
      end;
      if countpos ('captcha_sid', s) <> 0 then
      begin
        fs := TmemoryStream.Create;
        imageurl := Extract (Extract (s, '"[\d]*"'), '[\d]*[\w]');
        post.Add ('op=a_login_attempt');
        post.Add ('captcha_sid=' + imageurl);
        try http.Get ('http://vkontakte.ru/captcha.php?s=1&sid=' + imageurl, fs); except end;
        captcha := recognize ('jpg', antikey, fs);
        while captcha = 'ERROR_NO_SLOT_AVAILABLE' do captcha := recognize ('jpg', antikey, fs);
        post.Add ('captcha_key=' + captcha);
        s := httppost (http, 'http://vkontakte.ru/login.php', post);
        fs.Free; post.Clear;
      end;
      post.Add ('email=' + Extractproxy (account, '[^:]*[^:]', 0));
      post.Add ('pass=' + Extractproxy (account, '[^:]*[^:]', 1));
      post.Add ('expire=');
      post.Add ('vk=');
      s := httppost (http, 'http://login.vk.com/?act=login', post);
      post.Clear;
      if (countpos ('vklogin', s) > 0) and (http.ResponseCode = 302) then
      begin
        Result := 'false'; post.Free; exit;
      end;
      if ((countpos ('vklogin', s) > 0) and (http.ResponseCode = 200)) or (s = '') then
      begin
        Result := 'falseproxy'; post.Free; exit;
      end;
      post.Add ('op=slogin');
      post.Add ('redirect=1');
      post.Add ('expire=0');
      post.Add ('to=');
      post.Add ('s=' + deletestr (extract (s, '''s''\svalue=''[^'']*[^'']'), '''s'' value='''));
      s := httppost (http, 'http://vkontakte.ru/login.php', post);
      Result := 'true';
    end;
    Ну и пример использования:

    Code:
    procedure login;
    var
      http : tidhttp;
      coo : tidcookiemanager;
      s, account : widestring;
    begin
      http := tidhttp.create; http.handleredirects := true; http.readtimeout := 20000;
      coo := tidcookiemanager.create; http.allowcookies := true; http.cookiemanager := coo;
      
      account := '[email protected]:mega-password';
      
      showmessage (login_vk (http, account));
    end;
    ***

    А вот функции, треб. для работы этой функции (используются в каждом приложении) :

    Code:
    function httpGet (http : tidhttp; adr : widestring) : widestring;
    var
      str : tstringstream;
    begin
      str := tstringstream.Create('');
      try http.Get (adr, str); except end;
      Result := str.DataString;
      str.Free;
    end;
    
    function httpPost (http : tidhttp; adr : widestring; post : tstringlist) : widestring;
    var
      str : tstringstream;
    begin
      str := tstringstream.Create('');
      try http.post (adr, post, str); except end;
      Result := str.DataString;
      str.Free;
    end;
    
    function httpPostMulti (http : tidhttp; adr : widestring; post : Tidmultipartformdatastream) : widestring;
    var
      str : tstringstream;
    begin
      str := tstringstream.Create('');
      try http.post (adr, post, str); except end;
      Result := str.DataString;
      str.Free;
    end;
    
    function ExtractProxy (const AInputString : string ; buf : string; pos : integer) : string;
    var
      r : TRegExpr;
    begin
      Result := '';
      r := TRegExpr.Create;
      try
        r.Expression := buf;
        r.Exec (AInputString);
        Result := r.Match [0];
        if pos = 1 then
        begin
          r.ExecNext;
          Result := r.Match [0];
        end;
      finally r.Free;
      end;
    end;
    
    function Extract (const AInputString : string ; buf : string) : string;
    var
      r : TRegExpr;
    begin
      Result := '';
      r := TRegExpr.Create;
      try
        r.Expression := buf;
        if r.Exec (AInputString) then
          REPEAT
            Result := r.Match [0];
          UNTIL not r.ExecNext;
      finally r.Free;
      end;
    end;
    
    function deletestr (str, target : widestring) : widestring;
    var
      p : integer;
    begin
      while pos (target, str) > 0 do
      begin
        p := pos (target, str);
        delete (str, p, length (target));
      end;
      Result := str;
    end;
    
    function countpos (const subtext: string; Text: string): Integer;
    begin
      if (Length(subtext) = 0) or (Length(Text) = 0) or (Pos(subtext, Text) = 0) then Result := 0 else Result := (Length(Text) - Length(StringReplace(Text, subtext, '', [rfReplaceAll]))) div Length(subtext);
    end;
    
    function recognize (itype: string; key: string; image : tmemorystream) : string;
    var
      ftype, s, id: string;
      i: integer;
      http: tidhttp;
      multi: tidmultipartformdatastream;
    begin
      if strpos (pchar (itype), 'jpg') <> nil then ftype := 'image/pjpeg';
      if strpos (pchar (itype), 'gif') <> nil then ftype := 'image/gif';
      if strpos (pchar (itype), 'png') <> nil then ftype := 'image/png';
      multi := Tidmultipartformdatastream.Create;
      multi.AddFormField ('method', 'post');
      multi.AddFormField ('key', key);
      multi.AddObject ('file', ftype, 'UTF8',image, 'captcha.' + itype);
      http := tidhttp.Create;
      s := http.Post ('http://antigate.com/in.php', multi);
      http.Free; multi.Free;
      id := '';
      if strpos (Pchar (s), 'ERROR_') <> nil then begin result := s; exit; end;
      if strpos (Pchar (s), 'OK|') <> nil then id := AnsiReplaceStr (s, 'OK|', '');
      if id = '' then result := 'ERROR: bad captcha id';
      for i := 1 to 20 do
      begin
        sleep (5000);
        http := tidhttp.Create;
        s := http.Get ('http://antigate.com/res.php?key=' + key + '&action=get&id=' + id);
        http.Free;
        if strpos (Pchar (s), 'ERROR_') <> nil then begin result := s; exit; end;
        if strpos (Pchar (s), 'OK|') <> nil then
        begin
          result := AnsiReplaceStr (s, 'OK|', '');
          exit;
        end;
      end;
      result := 'ERROR_TIMEOUT';
    end;
     
    #4459 Пуховой, 22 Oct 2009
    Last edited: 22 Oct 2009
    1 person likes this.
  20. Rebit

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

    Joined:
    7 Aug 2007
    Messages:
    85
    Likes Received:
    214
    Reputations:
    2
    Помогите решить =) С мну +10
     
Thread Status:
Not open for further replies.