[Delphi] VKMiniDownloadVideo

Discussion in 'С/С++, C#, Rust, Swift, Go, Java, Perl, Ruby' started by 4ak, 25 Feb 2011.

  1. 4ak

    4ak Banned

    Joined:
    17 Feb 2009
    Messages:
    74
    Likes Received:
    117
    Reputations:
    6
    Нужна помощ.
    Когда идёт скачка видео нужно чтоб отображался процесс загрузки в баре

    Code:
    unit Unit1;
    
    interface
    
    uses
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
      Dialogs, StdCtrls, IdHTTP, IdBaseComponent, IdComponent, IdTCPConnection,
      IdTCPClient, IdAntiFreezeBase, IdAntiFreeze, IdCookieManager, ComCtrls,
      ExtCtrls,XPMan, sSkinProvider, sSkinManager, sPanel, sComboBoxes,
      Buttons, sSpeedButton, sColorSelect, sMonthCalendar, sLabel, sListView,
      acShellCtrls, sRadioButton, sScrollBar, sBitBtn, Mask, sMaskEdit,
      sStatusBar, sScrollBox, acHeaderControl, ToolWin, acCoolBar, acNoteBook,
      CoolTrayIcon, LsSpeedButton, AdvAlertWindow, acDBTextFX, acProgressBar,
      CategoryPanelGroup;
    
    type
      TForm1 = class(TForm)
        HTTP: TIdHTTP;
        IdAntiFreeze1: TIdAntiFreeze;
        IdCookieManager1: TIdCookieManager;
        Panel1: TPanel;
        Edit3: TEdit;
        Panel2: TPanel;
        Edit2: TEdit;
        Edit1: TEdit;
        Button3: TButton;
        ProgressBar1: TProgressBar;
        sknmngr1: TsSkinManager;
        sknprvdr1: TsSkinProvider;
        sbtbtn1: TsBitBtn;
        lbl1: TsLabelFX;
        lbl2: TsLabelFX;
        lbl3: TsLabelFX;
        lbl4: TsLabelFX;
        sbtbtn2: TsBitBtn;
        sDBTextFX1: TsDBTextFX;
        sdbtxtfx3: TsDBTextFX;
        stsbr1: TsStatusBar;
        lbl5: TsLabelFX;
        lbl6: TsLabelFX;
        procedure Button3Click(Sender: TObject);
        procedure Button2Click(Sender: TObject);
        procedure HTTPWork(ASender: TObject; AWorkMode: TWorkMode;
          AWorkCount: Int64);
        procedure HTTPWorkBegin(ASender: TObject; AWorkMode: TWorkMode;
          AWorkCountMax: Int64);
        procedure HTTPWorkEnd(ASender: TObject; AWorkMode: TWorkMode);
        procedure sbtbtn1Click(Sender: TObject);
        procedure sbtbtn2Click(Sender: TObject);
      private
        { Private declarations }
      public
        { Public declarations }
      end;
    
    var
      Form1: TForm1;
      f , v, title,Video , player:string;
    implementation
    
    {$R *.dfm}
    
    
    function Parse(str, str2, ob: string): string;
    var
      s1, s2: string;
    begin
      s1 := Copy(ob, pos(str, ob) + length(str), length(ob));
      s2 := Copy(s1, 1, pos(str2, s1) - 1);
      result := s2;
    end;
    
      function VideoVK(v:string):string ;
      var   li, lin, vkid, vtag ,ndd :string;
        begin
          v:=Parse(' loadFlashPlayer', ',"hash2":"', v);
          li:=Parse('"http:\/\/', '.vkontakte', v);
           if Length(li)=0 then
           begin
            li:=Parse('http:\/\/', '\/', v);
            lin:=parse(li+'\/','\/',v);
            vtag:= Parse('"vtag":"', '"', v);
            vkid:= Parse('vkid":"','","' ,v);
            Result:= 'http://'+li+'/'+lin+'/videos/'+vtag+vkid+'.vk.flv' ;
           end
          else
           begin
            vtag:= Parse('"vtag":"', '"', v);
            ndd:= Parse('"thumb":', '","hash":', v);
            ndd:= Parse('vkontakte.ru\/', '\/video', ndd);
            if Pos('no_flv":0',v)<>0 then
             Result:='http://'+li+'.vkontakte.ru/'+ndd+'/video/'+ vtag+'.flv'
            else
             Result:='http://'+li+'.vkontakte.ru/'+ndd+'/video/'+ vtag+'.240.mp4';
    
           end;
         end;
    
     (*******************************************************************************)
    
    procedure TForm1.Button2Click(Sender: TObject);
    begin
         v:= HTTP.Get(Edit3.Text);
         title:=Parse('">Видео</a> &raquo;','</h1></div>',v);
         Video:=VideoVK(v);
         Edit1.Text:=video;
         f:=Copy(Video,Length(Video)-3,4) ;
         Edit2.text:=title;
    
    end;
    
    procedure TForm1.Button3Click(Sender: TObject);
    var LoadStream: TMemoryStream;
    begin
       LoadStream := TMemoryStream.Create;
       HTTP.Get( Video, LoadStream);
       LoadStream.SaveToFile(ExtractFilePath(Application.ExeName)+title+f);
       Edit3.Text:='Видюха скачана в папку с программой';
       LoadStream.Free;
    end;
    
    procedure TForm1.HTTPWork(ASender: TObject; AWorkMode: TWorkMode;
      AWorkCount: Int64);
    begin
       progressbar1.Position:=AWorkCount;
    end;
    
    procedure TForm1.HTTPWorkBegin(ASender: TObject; AWorkMode: TWorkMode;
      AWorkCountMax: Int64);
    begin
       progressbar1.max:=AWorkCountMax;
    end;
    
    procedure TForm1.HTTPWorkEnd(ASender: TObject; AWorkMode: TWorkMode);
    begin
      Edit3.Clear;
      Edit1.Clear;
      Edit2.Clear;
      progressbar1.Position:=0;
    end;
    
    procedure TForm1.sbtbtn1Click(Sender: TObject);
    begin
         v:= HTTP.Get(Edit3.Text);
         title:=Parse('">Видео</a> &raquo;','</h1></div>',v);
         Video:=VideoVK(v);
         Edit1.Text:=video;
         f:=Copy(Video,Length(Video)-3,4) ;
         Edit2.text:=title;
    end;
    
    procedure TForm1.sbtbtn2Click(Sender: TObject);
    var LoadStream: TMemoryStream;
    begin
       LoadStream := TMemoryStream.Create;
       HTTP.Get( Video, LoadStream);
       LoadStream.SaveToFile(ExtractFilePath(Application.ExeName)+title+f);
       Edit3.Text:='Видюха скачана в папку с программой';
       LoadStream.Free;
    end;
    
    end.
    
     
    #1 4ak, 25 Feb 2011
    Last edited: 25 Feb 2011
  2. arnis

    arnis Member

    Joined:
    30 Jan 2011
    Messages:
    280
    Likes Received:
    23
    Reputations:
    0
    Перерисовывай компонент прогрес бар.
    procedure TForm1.HTTPWork(ASender: TObject; AWorkMode: TWorkMode;
    AWorkCount: Int64);
    begin
    progressbar1.Position:=AWorkCount;
    progressbar1.repaint;
    end;
     
Loading...