webfileman.pas

提取网页文件图片地址,应用此工具

unit WebFileMan;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, dialogs, comctrls,
    forms;
const
  KeyWord = 'img src="http://';
  JpgExtName = 'jpg';
  BmpExtName = 'bmp';
  GifExtName = 'gif';
type
  TWebFileMan = class(TComponent)
  private
    FFileEdit: TRichEdit;
    FJpgDown: boolean;
    FBmpDown: boolean;
    FGifDown: boolean;
    FWebFileName: string;
    FPicCount: integer;
    FPicAdressList: Tstrings;
    FFileStrings: Tstrings;
    FWebTitle: string;
    FBar: TProgressBar;
    FUseBar: boolean;
    FParForm: TForm;
    function GetPicCount: integer;
    procedure SetWebFileName(const Value: string);
    function GetWebTitle: string;
    procedure GetPicAdressFromStr(SourceStr, PicExtName: string);
    procedure GetPicAdress;
  protected

  public
    constructor create(AOwner: TComponent); override;
    destructor Destroy; override;
    property WebFileName: string read FWebFileName write SetWebFileName;
    property JpgDown: boolean read FjpgDown write FJpgDown;
    property BmpDown: boolean read FBmpDown write FBmpDown;
    property GifDown: boolean read FGifDown write FGifDown;
    property PicCount: integer read GetPicCount;
    property PicAdressList: Tstrings read FPicAdressList;
    property WebTitle: string read FWebTitle;
    property Bar: TProgressBar read FBar write FBar;
    property UseBar: boolean read FUseBar write FUseBar;
    property ParForm: TForm read FParForm write FParForm;
  end;
implementation

{ TWebFileMan }

constructor TWebFileMan.create(AOwner: TComponent);
begin
  inherited;
  FJpgDown := true;
  FBmpDown := false;
  FGifDown := false;
  FPicAdressList := TstringList.Create;
  FfileStrings := TstringList.Create;
  FUseBar := true;
  FFileEdit := TRichEdit.Create(Aowner);
  FFileEdit.ParentWindow := Application.Handle;
  FFileEdit.WantReturns := true;
  FFileEdit.WordWrap := false;
end;

destructor TWebFileMan.Destroy;
begin
  FPicAdressList.Free;
  FFileSTrings.Free;
  FFileEdit.Free;
  inherited;
end;

procedure TWebFileMan.GetPicAdress;
var
  i: integer;
  CurStr: string;
begin
  // if FUseBar = true then
   //  begin
   //   FBar.Visible := true;
   //   FBar.Position := 0;
   //   FBar.Max := FFileStrings.Count ;
   //  end;
  for i := 0 to FFileEdit.Lines.Count - 1 do
  begin
    CurStr := FFileEdit.Lines.Strings[i];
    if FJpgDown then
      GetPicAdressFromStr(CurStr, JpgExtName);
    if FBmpDown then
      GetPicAdressFromStr(CurStr, BmpExtName);
    if FGifDown then
      GetPicAdressFromStr(CurStr, GifExtName);
    //   if FUseBar then
    //    FBar.Position := i;
  end;
  // if FuseBar then
  //  FBar.Visible := false;
end;

procedure TWebFileMan.GetPicAdressFromStr(SourceStr, PicExtName: string);
var
  iPos1, iPos2: integer;
  lestStr: string;
begin
  SourceStr := AnsiLowerCase(SourceStr);
  if Pos(KeyWord, SourceStr) = 0 then
    exit;
  iPos1 := Pos(KeyWord, SourceStr);
  lestStr := copy(sourceStr, iPos1, length(sourceStr) - iPos1);

  if Pos('.' + PicExtName, lestStr) = 0 then
    exit;
  iPos2 := Pos('.' + PicExtName, lestStr);
  FPicAdressList.Add(copy(lestStr, 10, ipos2 - 6));
  GetPicAdressFromStr(copy(lestStr, 10 + iPos2 - 6, length(lestStr) - (10 + iPos2
    - 6)), PicExtName);

end;

function TWebFileMan.GetPicCount: integer;
begin
  result := FPicAdressList.Count;
end;

function TWebFileMan.GetWebTitle: string;
var
  i: integer;
  curStr: string;
  StartMark, EndMark: string;
  StartPos, EndPos: integer;
begin
  StartMark := '<title>';
  EndMark := '</title>';
  result := '无标题';
  for i := 1 to FFileEdit.Lines.Count do
  begin
    curStr := FFileEdit.Lines.Strings[i - 1];
    curStr := AnsiLowerCase(curStr);

    StartPos := Pos(StartMark, curStr);
    if startPos <> 0 then
    begin
      EndPos := Pos(EndMark, curStr);
      if EndPos <> 0 then
      begin
        result := copy(curStr, StartPos + length(StartMark), EndPos - StartPos -
          length(EndMark));
        exit;
      end
      else
      begin
        result := copy(curStr, StartPos + length(StartMark), length(curStr) -
          StartPos);
        exit;
      end;
    end;
  end;
end;

procedure TWebFileMan.SetWebFileName(const Value: string);
begin
  FWebFileName := Value;
  FPicAdressList.Clear;
  FFileEdit.Lines.LoadFromFile(Value);

  FWebtitle := GetWebTitle;
  GetPicAdress;
end;

end.