All pastes #483868 Raw Edit

Something

public text v1 · immutable
·published 2007-05-11 22:45 UTC
rendered paste body
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, pngextra, StdCtrls, IdCookieManager, IdBaseComponent, IdComponent,
  IdTCPConnection, IdTCPClient, IdHTTP, ExtCtrls, ComCtrls, Strutils,
  IdAntiFreezeBase, IdAntiFreeze;
type
  TForm1 = class(TForm)
    ListView1: TListView;
    Panel1: TPanel;
    IdHTTP1: TIdHTTP;
    IdCookieManager1: TIdCookieManager;
    Legenda: TEdit;
    Label1: TLabel;
    PNGButton1: TPNGButton;
    StatusBar1: TStatusBar;
    ProgressBar1: TProgressBar;
    Label2: TLabel;
    procedure IdHTTP1WorkEnd(ASender: TObject; AWorkMode: TWorkMode);
    procedure StatusBar1DrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel;
      const Rect: TRect);
    procedure IdHTTP1Work(ASender: TObject; AWorkMode: TWorkMode;
      AWorkCount: Integer);
    procedure IdHTTP1WorkBegin(ASender: TObject; AWorkMode: TWorkMode;
      AWorkCountMax: Integer);
    procedure ListView1DblClick(Sender: TObject);
    procedure PNGButton1Click(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

 TThread1 = class(TThread)
 protected
   procedure Execute; override;
 end;
 TThread2 = class(TThread)
 protected
   procedure Execute; override;
 end;

var
  Form1: TForm1;
  TH1: TThread1;
  TH2: TThread2;
implementation

{$R *.dfm}
function FiltrarHtml(Source: String): String;
begin
  Result := StringReplace(Source, 'á', 'á',[rfReplaceAll]);
  Result := StringReplace(Result, 'é', 'é',[rfReplaceAll]);
  Result := StringReplace(Result, 'í', 'i',[rfReplaceAll]);
  Result := StringReplace(Result, 'ó', 'ó' ,[rfReplaceAll]);
  Result := StringReplace(Result, 'ú', 'ú',[rfReplaceAll]);
  Result := StringReplace(Result, 'à', 'à',[rfReplaceAll]);
  Result := StringReplace(Result, 'è', 'è',[rfReplaceAll]);
  Result := StringReplace(Result, 'ì', 'ì',[rfReplaceAll]);
  Result := StringReplace(Result, 'ò', 'ò' ,[rfReplaceAll]);
  Result := StringReplace(Result, 'ù', 'ù',[rfReplaceAll]);
  Result := StringReplace(Result, 'ç', 'ç',[rfReplaceAll]);
  Result := StringReplace(Result, 'ï', 'ï',[rfReplaceAll]);
  Result := StringReplace(Result, 'ü', 'ü',[rfReplaceAll]);
  Result := StringReplace(Result, '&', '&',[rfReplaceAll]);
  Result := StringReplace(Result, '?>', '>',[rfReplaceAll]);
  Result := StringReplace(Result, '&lt;', '<',[rfReplaceAll]);
  Result := StringReplace(Result, '&quot;', '"',[rfReplaceAll]);
  Result := StringReplace(Result, '&nbsp;', EmptyStr,[rfReplaceAll]);
  Result := StringReplace(Result, '&atilde;', 'ã',[rfReplaceAll]);
  Result := StringReplace(Result, '&otilde;', 'õ',[rfReplaceAll]);
  Result := StringReplace(Result, '&ocirc;', 'ô', [rfReplaceAll]);
  Result := StringReplace(Result, '&ordm;', '°', [rfReplaceAll]);
  Result := StringReplace(Result, '&ordf;', 'ª', [rfReplaceAll]);
  end;

function Buscar(html,Inicio,fim: string): string;
var i,f: integer;
S: String;
begin
  S := LowerCase(html);
  Inicio:=LowerCase(Inicio);
  Fim:=LowerCase(Fim);
  i:=Pos(Inicio,S)+Length(Inicio);
  f:=PosEx(fim,S, i);
  result:=trim(Copy(html,i,f-i));
end;

function GetFileName(const FileName: string): string;
var
  I: Integer;
begin
  I := LastDelimiter('/', FileName) + 1;
  if I > 0 then
    Result := Copy(FileName, I, MaxInt) else
    Result := '';
end;


procedure TForm1.IdHTTP1Work(ASender: TObject; AWorkMode: TWorkMode;
  AWorkCount: Integer);
  begin
    StatusBar1.Repaint;
    ProgressBar1.Position := AWorkCount;
    Statusbar1.Panels[0].text := 'Conectando ao host';
    //Statusbar1.Panels[0].text := 'Total de Bytes enviados :' + inttostr(ProgressBar1.Max);
end;

procedure TForm1.IdHTTP1WorkBegin(ASender: TObject; AWorkMode: TWorkMode;
  AWorkCountMax: Integer);
begin
StatusBar1.Repaint;
ProgressBar1.Position := 0;
ProgressBar1.Max := AWorkCountMax;
end;

procedure TForm1.IdHTTP1WorkEnd(ASender: TObject; AWorkMode: TWorkMode);
begin
StatusBar1.Repaint;
ProgressBar1.Position := ProgressBar1.Max;
Statusbar1.Panels[0].text := 'Completado';
end;

procedure TForm1.ListView1DblClick(Sender: TObject);
begin
  TH2 := TThread2.Create(true);
  TH2.Resume;
end;

procedure TThread2.Execute;
var
  fs: TFileStream;
  S, z: String;
begin
 inherited;
 with Form1 do
 begin
  CreateDir(extractfilepath(paramstr(0))+'Legendas\');
  Statusbar1.Panels[0].text := 'Criando pasta "Legendas"';
  z := ListView1.Selected.SubItems[5];
  IdHTTP1.Head('http://www.legendas.tv/info.php?d='+z+'&c=1');
  S := GetFileName(IdHTTP1.Request.URL);
  fs := TFileStream.Create(extractfilepath(paramstr(0))+ 'Legendas\' + S, fmCreate or fmShareDenyNone);
  IdHTTP1.Get('http://www.legendas.tv/info.php?d='+z+'&c=1', fs);
  Statusbar1.Panels[0].text := 'Download da Legenda concluido';
  Fs.Free;
 end;
end;


procedure TForm1.PNGButton1Click(Sender: TObject);
begin
  TH1 := TThread1.Create(true);
  TH1.Resume;
end;

procedure TThread1.Execute;
const
  Site = 'http://www.legendas.tv/index.php?opcao=buscarlegenda';
  var
  S, G, H, I, J, L, O, W: String;
  A,B, Count: Integer;
  itm: TListItem;
  Params, Params2:TstringStream;
begin
inherited;
with form1 do
if (length(Legenda.Text) = 0) then
begin
Legenda.Color := clSkyBlue; Legenda.SetFocus;
end
else
begin
  Params2 := TStringStream.create('');
  Params2.WriteString('&txtLogin=robertokelsen');
  Params2.WriteString('&txtSenha=rk2911');
 with idhttp1 do
 begin
  Request.ContentType := 'application/x-www-form-urlencoded';
  Request.Referer := 'http://www.legendas.tv/login_verificar.php';
  try
  Statusbar1.Panels[0].text := 'Fazendo login';
  Post('http://www.legendas.tv/login_verificar.php', Params2);
  Params := TStringStream.create('');
  Params.WriteString('&txtLegenda='+Legenda.text);
  Params.WriteString('&int_idioma=99');
  Params.WriteString('&btn_buscar=');
  S := post(Site, params);
  Statusbar1.Panels[0].text := 'Fazendo busca';
  s:=FiltrarHtml(S);
    Count := 0;
    if Count < 100 then
    begin
    while Pos('class=\'+#39+'laranjab\'+#39+'>', S) > 0 do
   begin
    A := Pos('class=\'+#39+'laranjab\'+#39+'>', S) + Length('class=\'+#39+'laranjab\'+#39+'>');
    B := PosEx('class=\'+#39+'branco\'+#39+'>', S, a);
      itm := ListView1.Items.Add;
     W := Buscar(S, 'class=\'+#39+'laranjab\'+#39+'>', '</td>');
     W := StringReplace(W, '<br />', ' - ', [rfReplaceAll]);
     itm.caption := W;
    Inc(Count);
    Delete(S, 1, B);
    O:=Buscar(S, 'class=\'+#39+'branco\'+#39+'>', '</td></tr>');
        itm.SubItems.Add(O);
    G := Buscar(S, '<strong>Tamanho:</strong>', '</td>');
        itm.SubItems.Add(G);
    H := Buscar(S, '</div></td><td><img src=\'+#39+'images/flag_', '.gif\'+#39+' border=\'+#39+'0\'+#39+'></td>');
        itm.SubItems.Add(UpperCase(H));
    I := Buscar(S, '<strong>CDs:</strong>', '</td>');
        itm.SubItems.Add(I);
    J := Buscar(S, '<strong>FPS:</strong>', '</td>');
        itm.SubItems.Add(UpperCase(J));
    L := Buscar(S, 'onclick="javascript:abredown('+#39, #39+');"');
        itm.SubItems.Add(L);
    Statusbar1.Panels[0].Text := 'Foram encontrados: '+Inttostr(Count)+' legenda(s)';
    end;
    end;
   except
    on E: Exception do
   Statusbar1.Panels[0].text := ('Erro durante a transação do post: ' + E.Message);
   end;
 end;
 params2.Free;
end;
end;

procedure TForm1.StatusBar1DrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel;
  const Rect: TRect);
begin
  if Panel.Index = 1 then begin
  ProgressBar1.Width := Rect.Right - Rect.Left +1;
  ProgressBar1.Height := Rect.Bottom - Rect.Top +1;
  ProgressBar1.PaintTo(StatusBar.Canvas.Handle, Rect.Left, Rect.Top);
  end;
end;

end.