[ 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. ZirroCool

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

    Joined:
    16 Sep 2006
    Messages:
    128
    Likes Received:
    55
    Reputations:
    20
    Буду очень признателен если мне кто нить прокоментирует подробно что делает каждая строка по пунктам! Спасибо

    Code:
    idx:=pos('<a style="background-color:#000000" href="', response)+42;
    buff:=Copy(response, idx, Length(response)-idx+1);
    idy:=pos('">', buff)-1;
    buff:=Copy(buff, 1, idy);
    linkedit.text:=buff;
     
  2. Lesnoy_chelovek

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

    Joined:
    6 Dec 2006
    Messages:
    224
    Likes Received:
    152
    Reputations:
    8
    в idx вычисляет позицию строки в которой содержится текст <a style="background-color:#000000" href="
    buff копирует все что до строки <a style="background-color:#000000" href="
    idy вычисляет где закрывается тег в скоипированной строке
    buff копирует строку
    linkedit.text - получает текст

    по ходу этот код просто парсит ссылочку
     
  3. ZirroCool

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

    Joined:
    16 Sep 2006
    Messages:
    128
    Likes Received:
    55
    Reputations:
    20
    А что такое +42 +1 -1 ???

    и idy:=pos('">', buff)-1; //тут -1 это -1 символ или что?
     
  4. Lesnoy_chelovek

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

    Joined:
    6 Dec 2006
    Messages:
    224
    Likes Received:
    152
    Reputations:
    8
    и символ, то есть минус скобочка. выше тоже символы вычисляет.
     
    2 people like this.
  5. ZirroCool

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

    Joined:
    16 Sep 2006
    Messages:
    128
    Likes Received:
    55
    Reputations:
    20
    Извиняюсь за тупость уже сам разобрался!!!
     
  6. ZirroCool

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

    Joined:
    16 Sep 2006
    Messages:
    128
    Likes Received:
    55
    Reputations:
    20
    Code:
    procedure Tmainform.FormCreate(Sender: TObject);
    begin
     sss:=idHTTP.Get('http://files.xxx.org/index.php');
     sss:=idHTTP.Get('http://files.xxx.org/captcha/index.php');
     assignfile(fil,'111.jpg');
     rewrite(fil);
     writeln(fil,sss);
     closefile(fil);
     image2.Picture.LoadFromFile('111.jpg');
    
    
    procedure Tmainform.startClick(Sender: TObject);
    var
    idx, idy:integer;
    FileName, buff: string;
    formData: TIdMultiPartFormDataStream;
    f:textfile;
    begin
    if size > 5242880 then begin
    MessageDlg('Íåëüçÿ çàãðóæàòü ôàéë áîëüøå 5 Ìá', mtError, [mbOk] , 0);
    exit;
    end;
    FileName := nametofile.Hint;
    formData := TIdMultiPartFormDataStream.Create;
    formData.AddFile('usrfile',fileName,'application/octet-stream');
    //HttpObject.Port := Port;
    formData.AddFormField('simbols',Edit1.text);
    sss := idHTTP.Post('http://files.xxx.org/index.php',formData);
    assignfile(f,'a.txt');
    rewrite(f);
    writeln(f,sss);
    closefile(f);
    idx:=pos('<a style="background-color:#000000" href="', sss)+42;
    buff:=Copy(sss, idx, Length(sss)-idx+1);
    idy:=pos('">', buff)-1;
    buff:=Copy(buff, 1, idy);
    linkedit.text:=buff;
    formData.Free;
    end;

    Собсна возник вопрос передачи файла! Проблема такая же как и в предыдущем моем посте,дело в сейсии, ток я не пойму почему не работает?

    Исправьте пжалст!
     
  7. dx4r

    dx4r New Member

    Joined:
    13 Apr 2008
    Messages:
    8
    Likes Received:
    0
    Reputations:
    0
    Как беспрерывно проиграть mp3?

    Мне нужно, штоб после нажатия на Button1, беспрерывно проиговался mp3 трек, до тех пор, когда не будет нажата кнопка Button2. Как сделать?
     
    #1547 dx4r, 17 May 2008
    Last edited: 17 May 2008
  8. De-visible

    De-visible [NDC] Network develope c0ders

    Joined:
    6 Jan 2008
    Messages:
    916
    Likes Received:
    550
    Reputations:
    66
    Брось на форму компонент TMediaPlayer(Mediaplayer1)
    И вот:

    Code:
    procedure TForm2.Button1Click(Sender: TObject);
    begin
    MediaPlayer1.Play;
    end;
    
    procedure TForm2.Button2Click(Sender: TObject);
    begin
    MediaPlayer1.Stop;
    end;
     
    1 person likes this.
  9. dx4r

    dx4r New Member

    Joined:
    13 Apr 2008
    Messages:
    8
    Likes Received:
    0
    Reputations:
    0
    :) , вы меня не так поняли. Приклад: включилась сигнализация и она звучит до тех пор, пока ее не выключат. В вашем коде она сама остановится.
     
    #1549 dx4r, 18 May 2008
    Last edited: 18 May 2008
  10. De-visible

    De-visible [NDC] Network develope c0ders

    Joined:
    6 Jan 2008
    Messages:
    916
    Likes Received:
    550
    Reputations:
    66
    Code:
    procedure TForm1.MediaPlayer1Notify(Sender: TObject);//Событие MediaPlayer
    begin
      with TMediaPlayer(Sender) do
      if (Position = Length) then
        Play;
    end;
    
    Но лучше писать на WinApi, сдесь будет заметна пауза....
     
  11. Tees

    Tees Banned

    Joined:
    3 Feb 2007
    Messages:
    52
    Likes Received:
    6
    Reputations:
    0
    Подскажите пожалуйста, как выставить время виндовс?
    Например:
    Code:
    procedure TForm1.Button1Click(Sender: TObject);
    begin
      "выставить время на 30 сек назад" (????????)
    end;
    Спасибо.
     
    #1551 Tees, 18 May 2008
    Last edited: 18 May 2008
  12. 0verbreaK

    0verbreaK Elder - Старейшина

    Joined:
    30 Apr 2008
    Messages:
    318
    Likes Received:
    42
    Reputations:
    -3
    Для это существуют функции Win APi

    GetSystemTime и SetSystemTime

    Code:
    // получить секунды системного времени
    var
      lpSystemTime: _SYSTEMTIME;
    begin
      GetSystemTime(lpSystemTime);
      ShowMessage(IntToStr(lpSystemTime.wSecond));
    
    
    // изменить
      lpSystemTime.wSecond := lpSystemTime.wSecond - 30;
      SetSystemTime(lpSystemTime);
    
    в качесте параметра передается переменная типа структуры, в которой

    Code:
      _SYSTEMTIME = record
        wYear: Word;   // год
        wMonth: Word;  // месяц
        wDayOfWeek: Word; // день недели
        wDay: Word;  // день
        wHour: Word; // час
        wMinute: Word; // минуты
        wSecond: Word; // секунды
        wMilliseconds: Word;  // милисекунды
    
     
    #1552 0verbreaK, 18 May 2008
    Last edited: 18 May 2008
    1 person likes this.
  13. KIR@PRO

    KIR@PRO from Exception

    Joined:
    26 Dec 2007
    Messages:
    826
    Likes Received:
    291
    Reputations:
    359
    привет подскажите пжлста как загрузить страничку если для доступа нужно проити авторизацию (header)... и в добавок ето все по https
     
    _________________________
    #1553 KIR@PRO, 18 May 2008
    Last edited: 18 May 2008
    1 person likes this.
  14. KIR@PRO

    KIR@PRO from Exception

    Joined:
    26 Dec 2007
    Messages:
    826
    Likes Received:
    291
    Reputations:
    359
    De-visible на счет сокетов то я знаю и какуюнибудь другую гадость я брать не хачу.... но мне нужен пример как все ето проделать да ешо и по https.....



    и ешо мне стыдно (((((( я не знаю как отправить логин и пароль в ответ на запрос (Header) ((((((( стыдоба......
     
    _________________________
  15. Lesnoy_chelovek

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

    Joined:
    6 Dec 2006
    Messages:
    224
    Likes Received:
    152
    Reputations:
    8
    KIR@PRO, получите и распишитесь:
    Code:
    Для отправки на вебсервер используется следующий формат:
    
    Напрямую: 'POST ' + PostAddr + 'HTTP/1.0' + HTTP_Data + Content 
    
    Через проксю:  'POST http://' Webserver + PostAddr + 'HTTP/1.0' + HTTP_Data + Content 
    
    } 
    
     
    
     
    
    Const 
    
    WebServer = 'www.somehost.com'; 
    
    WebPort   = 80; 
    
    PostAddr  = '/cgi-bin/form'; 
    
     
    
    { Следующие переменные используются только для вебсервера: } 
    
    ProxyServer ='proxy.somewhere.com'; 
    
    ProxyPort   = 3128; 
    
     
    
    // В заголовке post необходимы некоторые данные
    
    HTTP_Data = 
    
       'Content-Type: application/x-www-form-urlencoded'#10+ 
    
       'User-Agent: Delphi/5.0 ()'#10+    { Отрекламируем Delphi 5! } 
    
       'Host: somewhere.com'#10+ 
    
       'Connection: Keep-Alive'#10; 
    
     
    
    type 
    
    T...Form = class(TForm) 
    
       ... 
    
    private 
    
       { Private declarations } 
    
       HTTP_POST   : String; 
    
       FContent    : String; 
    
       FResult     : String; // Эта переменная будет содержать ответ сервера
    
    public 
    
       { Public declarations } 
    
    end; 
    
     
    
     
    
    { Эти функции сделают некоторое url-кодирование } 
    
    { Например.   'John Smith' => 'John+Smith'  } 
    
    function HTTPTran(St : String) : String; 
    
    var i : Integer; 
    
    begin 
    
    Result:=''; 
    
    for i:=1 to length(St) do 
    
       if St[i] in ['a'..'z','A'..'Z','0','1'..'9'] then 
    
         Result:=Result+St[i] 
    
       else if St[i]=' ' then 
    
         Result:=Result+'+' 
    
       else 
    
         Result:=Result+'%'+IntToHex(Byte(St[i]),2); 
    
    end; 
    
     
    
    procedure T...Form.ClientSocket1Write(Sender: TObject; 
    
    Socket: TCustomWinSocket); 
    
    begin 
    
    // Постим данные
    
    Socket.SendText(HTTP_POST+FContent); 
    
    end; 
    
     
    
    procedure T...Form.ClientSocket1Read(Sender: TObject; 
    
    Socket: TCustomWinSocket); 
    
    begin 
    
    // Получаем результат
    
    FResult:=FResult+Socket.ReceiveText; 
    
    end; 
    
     
    
    procedure T...Form.ClientSocket1Disconnect(Sender: TObject; 
    
    Socket: TCustomWinSocket); 
    
    begin 
    
    // ЗДЕСЬ МОЖНО ОБРАБОТАТЬ FResult // 
    
    end; 
    
     
    
    procedure T...Form.ClientSocket1Error(Sender: TObject; 
    
    Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; 
    
    var ErrorCode: Integer); 
    
    begin 
    
    ErrorCode := 0; // Игнорируем ошибки
    
    end; 
    
     
    
     
    
    { 
    
    А эта подпрограмма, которую можно использовать для постинга данных формы.
    
    } 
    
    procedure T...Form.PostTheForm; 
    
    begin 
    
    // Очищаем результаты
    
    FResult:=''; 
    
     
    
    // Вы можете ввести поля формы, которые необходимы
    
    // Вот некоторые примеры:
    
    FContent:= 
    
      'Name='+    HTTPTran('John Smith')            +'&'+ 
    
      'Address='+ HTTPTran('1 Waystreet')          +'&'+ 
    
      'Email='+   HTTPTran('[email protected]') +'&'+ 
    
      'B1=Submit'+ 
    
      #10; 
    
     
    
    // Вычисляем длину содержимого
    
    FContent:= 
    
       'Content-Length: '+IntToStr(Length(FContent))+#10+#10+FContent; 
    
     
    
    {-- Начало прокси ---} 
    
    { если Вы используете прокси, то раскоментируйте этот код
    
    ClientSocket1.Host := ProxyServer; 
    
    ClientSocket1.Port := ProxyPort; 
    
    HTTP_POST := 'POST http://'+WebServer+PostAddr+' HTTP/1.0'#10; 
    
    {--- Конец прокси ---} 
    
     
    
    {--- Начало соединения напрямую --- } 
    
    { удалите этот код, еслы Вы будете использовать прокси }
    
    ClientSocket1.Host := WebServer; 
    
    ClientSocket1.Port := WebPort; 
    
    HTTP_POST := 'POST '+PostAddr+' HTTP/1.0'#10; 
    
    {--- Конец соединения напрямую ---} 
    
     
    
    // Соединяем заголовок
    
    HTTP_Post := HTTP_Post + HTTP_Data; 
    
     
    
    // Пытаемся открыть соединение
    
    ClientSocket1.Open; 
    
    end;
     
  16. KIR@PRO

    KIR@PRO from Exception

    Joined:
    26 Dec 2007
    Messages:
    826
    Likes Received:
    291
    Reputations:
    359
    Lesnoy_chelovek спс щас + непоставлю т.к. уже исчерпал...... завтра обязательно отблагодарю ;)

    Но вот тока ты видимо невнимательно прочитал..... как просто по http я знаю а вот как по HTTPS
    да и еще аторизацию пройти надо (это когда у тебя появляется окно введите имя и пароль и при неправильном вводе 3 раза появляется надмись типа этой: Autentification falied) как мне пройти ето программно.... да еще в добавок HTTPS защищенный.....

    лан попробую ешо покопаюсъ
     
    _________________________
    #1556 KIR@PRO, 19 May 2008
    Last edited: 19 May 2008
  17. Andres

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

    Joined:
    4 Apr 2008
    Messages:
    320
    Likes Received:
    119
    Reputations:
    0
    Ребят помогите разобраться.

    Хочу написать маленьку программу

    Почему не работает программа?

    Code:
    program matching;
    var x,y:integer;
    begin
         writeln;
         write('Введите значение X '); 
         read(x);
         write('Введите значение Y ');  
         readln(y);
         case x-y of
           0:writeln ('X и Y равны');
           else
           writeln ('X и Y не равны');
         end;
    end.
     
    #1557 Andres, 19 May 2008
    Last edited: 19 May 2008
  18. merax

    merax Member

    Joined:
    3 Jul 2007
    Messages:
    18
    Likes Received:
    6
    Reputations:
    0
    case поменяй на if а то бред какой-то

    Code:
    program matching;
    uses crt;
    var x, y : integer;
    begin
    writeln;
    write('Input value X = ');
    read(x);
    write('Input value Y = ');
    read(y);
    if x - y = 0 then  write ('X = Y')
    else
       write('X <> Y');
    readkey;
    end.
     
    #1558 merax, 19 May 2008
    Last edited: 19 May 2008
  19. Lesnoy_chelovek

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

    Joined:
    6 Dec 2006
    Messages:
    224
    Likes Received:
    152
    Reputations:
    8
    Попробуй так:
    Code:
    program matching;
    var x,y:integer;
    begin
         writeln('Введите значение X '); 
         readln(x);
         writeln('Введите значение Y ');  
         readln(y);
         case (x-y) of
           0:writeln ('X и Y равны');
           else
           writeln ('X и Y не равны');
         end;
    end.
    Я бы сделал вот так:
    Code:
    program matching;
    var x,y:integer;
    begin
         write('Введите значение X '); 
         readln(x);
         writeln('Введите значение Y ');  
         readln(y);
        if (x=y) then writeln ('X и Y равны')
           else writeln ('X и Y не равны');
    end.
     
  20. Andres

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

    Joined:
    4 Apr 2008
    Messages:
    320
    Likes Received:
    119
    Reputations:
    0
    Блин выводит только "Введите значение X", а остальное нет..:(
     
Thread Status:
Not open for further replies.