home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / nastroje / d5 / MFTP.ZIP / src / FtpSearch.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-03-05  |  9.1 KB  |  336 lines
  1. unit FtpSearch;
  2.  
  3. interface
  4.  
  5. uses
  6.    Windows, SysUtils, Classes, Forms, WinINet, FtpData, FtpMisc;
  7.  
  8. {$I mftp.inc}
  9.  
  10. const
  11.    SearchTypeStr: Array[0..10] of String = (
  12.       'Case+insensitive+substring+search',
  13.       'Case+sensitive+substring+search',
  14.       'Case+insensitive+glob+search',
  15.       'Case+sensitive+glob+search',
  16.       'Regular+expression+search',
  17.       'Exact+search',
  18.       'Case+insensitive+substring+match',
  19.       'Case+sensitive+substring+match',
  20.       'Case+insensitive+glob+match',
  21.       'Case+sensitive+glob+match',
  22.       'Regular+expression+match');
  23.  
  24. type
  25.    { C = case, I = insensitive, N = sensitive,
  26.      G = glob, E = Exact, X = expression,
  27.      S = search, M = match, R = Regular,
  28.      U = substring }
  29.  
  30.    TMFtpSearchType = (mstCIUS, mstCNUS, mstCIGS, mstCNGS,
  31.                       mstRXS, mstES, mstCIUM, mstCNUM,
  32.                       mstCIGM, mstCNGM, mstEXM);
  33.  
  34.    TMFtpDataEvent = procedure (Data: String) of object;
  35.  
  36.    TMFtpSearchInfo = (searchStart, searchDone, searchFileFound);
  37.    TMFtpSearchInfoEvent = procedure (Sender: TObject; info: TMFtpSearchInfo; addinfo: String) of object;
  38.  
  39.    TMFtpSearchThread = class(TThread)
  40.    private
  41.       FCache:                    Boolean;
  42.       FData:                     String;
  43.       FOnData:                   TMFtpDataEvent;
  44.       FPort:                     Integer;
  45.       FProxy:                    Boolean;
  46.       FRFile:                    String;
  47.       FServer:                   String;
  48.       FTag:                      Integer;
  49.    protected
  50.       procedure Execute; override;
  51.  
  52.       property OnData: TMFtpDataEvent read FOnData write FOnData;
  53.    public
  54.       constructor Create(RemoteFile, Server: String; Port: Integer;
  55.                          Cache, Proxy: Boolean);
  56.  
  57.       property Tag: Integer read FTag write FTag;
  58.    end;
  59.  
  60.    TMFtpSearch = class(TComponent)
  61.    private
  62.       FBusy:                     Boolean;
  63.       FCache:                    Boolean;
  64.       FFile:                     String;
  65.       FFiles:                    TMFtpFileInfoList;
  66.       FFromDate:                 String;
  67.       FMaxHit:                   Longword;
  68.       FMaxMatch:                 Longword;
  69.       FMaxSize:                  Longword;
  70.       FMinSize:                  Longword;
  71.       FProxy:                    Boolean;
  72.       FSearchInfoEvent:          TMFtpSearchInfoEvent;
  73.       FServer:                   TStrings;
  74.       FToDate:                   String;
  75.       FType:                     TMFtpSearchType;
  76.  
  77.       function BuildURL: String;
  78.  
  79.       procedure Parse(L: TStringList);
  80.       procedure SetServer(S: TStrings);
  81.       procedure ThreadData(Data: String);
  82.    public
  83.       constructor Create(AOwner: TComponent); override;
  84.       destructor Destroy; override;
  85.  
  86.       procedure Search;
  87.  
  88.       property Busy: Boolean read FBusy;
  89.       property Files: TMFtpFileInfoList read FFiles;
  90.    published
  91.       property Cache: Boolean read FCache write FCache;
  92.       property Filename: String read FFile write FFile;
  93.       property MaxHit: Longword read FMaxHit write FMaxHit;
  94.       property MaxMatch: Longword read FMaxMatch write FMaxMatch;
  95.       property MaxSize: Longword read FMaxSize write FMaxSize;
  96.       property MinSize: Longword read FMinSize write FMinSize;
  97.       property Proxy: Boolean read FProxy write FProxy;
  98.       property SearchType: TMFtpSearchType read FType write FType;
  99.       property Server: TStrings read FServer write SetServer;
  100.  
  101.       property OnSearchInfo: TMFtpSearchInfoEvent read FSearchInfoEvent write FSearchInfoEvent;
  102.    end;
  103.  
  104. implementation
  105.  
  106. { TMFtpSearchThread }
  107.  
  108. constructor TMFtpSearchThread.Create;
  109. begin
  110.    FRFile := RemoteFile;
  111.    FServer := Server;
  112.    FPort := Port;
  113.    FCache := Cache;
  114.    FProxy := Proxy;
  115.    FData := '';
  116. end;
  117.  
  118. procedure TMFtpSearchThread.Execute;
  119. var FHandle, FHttpHandle, FRequest: HINTERNET;
  120.     DataLen: Longword;
  121.     Data: PChar;
  122. begin
  123.    if FProxy then
  124.       FHandle := InternetOpen('MFtpINet', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0)
  125.    else
  126.       FHandle := InternetOpen('MFtpINet', INTERNET_OPEN_TYPE_DIRECT, nil, nil, 0);
  127.  
  128.    if FHandle = nil then
  129.    begin
  130.       OnData('');
  131.       Exit;
  132.    end;
  133.  
  134.    FHttpHandle := InternetConnect(FHandle, PChar(FServer), FPort, '', '',
  135.                                   INTERNET_SERVICE_HTTP, 0, 0);
  136.    if FCache then
  137.       FRequest := HttpOpenRequest(FHttpHandle, nil, PChar(FRFile), nil, nil,
  138.                   nil, 0, 0)
  139.    else
  140.       FRequest := HttpOpenRequest(FHttpHandle, nil, PChar(FRFile), nil, nil,
  141.                   nil, INTERNET_FLAG_RELOAD, 0);
  142.  
  143.    HttpSendRequest(FRequest, nil, 0, nil, 0);
  144.  
  145.    GetMem(Data, 4097);
  146.  
  147.    while True do
  148.    begin
  149.       if not InternetReadFile(FRequest, Data, 4096, DataLen) then
  150.       begin
  151.          Break;
  152.       end
  153.       else
  154.       begin
  155.          if DataLen = 0 then Break; // No more data to read
  156.  
  157.          Data[DataLen] := Char(0);
  158.          FData := FData + StrPas(Data);
  159.       end;
  160.    end;
  161.  
  162.    if Assigned(FOnData) then FOnData(FData);
  163.  
  164.    FreeMem(Data);
  165.    InternetCloseHandle(FRequest);
  166.    InternetCloseHandle(FHttpHandle);
  167.    InternetCloseHandle(FHandle);
  168. end;
  169.  
  170. { TMFtpSearch }
  171.  
  172. constructor TMFtpSearch.Create;
  173. begin
  174.    inherited Create(AOwner);
  175.  
  176.    FServer := TStringList.Create;
  177.    FServer.Add('ftpsearch.lycos.com:80');
  178.  
  179.    FFiles := TMFtpFileInfoList.Create;
  180.  
  181.    FCache := True;
  182.  
  183.    FMaxHit := 200;
  184.    FMaxMatch := 200;
  185. end;
  186.  
  187. destructor TMFtpSearch.Destroy;
  188. begin
  189.    FreeAndNil(FServer);
  190.    FFiles.MyFree;
  191.  
  192.    inherited Destroy;
  193. end;
  194.  
  195. function TMFtpSearch.BuildURL;
  196. begin
  197.    Result := '/ftpsearch?query=' + PrepareURL(Trim(FFile)) + '&form=advanced' +
  198.              '&hits=' + IntToStr(FMaxHit) + '&matches=' + IntToStr(FMaxMatch) +
  199.              '&doit=Search&f1=Count&f2=Mode&f3=Len&f4=Date&f5=Time&f6=Name' +
  200.              '&limtime1=' + PrepareURL(Trim(FFromDate)) + '&limtime2=' +
  201.              PrepareURL(Trim(FToDate));
  202.  
  203.    if FMinSize > 0 then
  204.    begin
  205.       Result := Result + '&limsize1=' + IntToStr(FMinSize);
  206.  
  207.       if FMinSize <= FMaxSize then
  208.          Result := Result + '&limsize2=' + IntToStr(FMaxSize);
  209.    end;
  210. end;
  211.  
  212. procedure TMFtpSearch.SetServer;
  213. begin
  214.    if not FBusy then FServer.Assign(S);
  215. end;
  216.  
  217. procedure TMFtpSearch.Parse;
  218. var Attrib, Size, DT, URL, S: String;
  219.     i, j, j1: Integer;
  220. begin
  221.    for i := 0 to L.Count - 1 do
  222.    begin
  223.       S := Trim(L[i]);
  224.  
  225.       j := Pos('<TT>', S);
  226.       if j > 0 then
  227.       begin
  228.          j1 := Pos('</TT>', S);
  229.          Attrib := Trim(Copy(S, j + 4, j1 - j - 4));
  230.          Delete(S, 1, j1 + 5);
  231.  
  232.          j := Pos('<B>', S );
  233.          j1 := Pos('</B>', S);
  234.          Size := Trim(Copy(S, j + 3, j1 - j - 3));
  235.          Delete(S, 1, j1 + 4);
  236.  
  237.          j := Pos('<A HREF="', S);
  238.          DT := Trim(Copy(S, 1, j - 1));
  239.          Delete(S, 1, j + 8);
  240.  
  241.          j := Pos('">', S);
  242.          URL := Trim(Copy(S, 1, j - 1));
  243.  
  244.          // work arounds here
  245.          if Copy(URL, 1, 6) <> 'ftp://' then
  246.          begin
  247.             j := Pos('oquery=', URL);
  248.             URL := 'ftp://' + Copy(URL, j + 7, 9999);
  249.          end;
  250.  
  251.          j := Pos('type=Navigate&query=', URL);
  252.  
  253.          if j > 0 then
  254.          begin
  255.             URL := 'ftp://' + Copy(URL, j + 20, 9999);
  256.  
  257.             j := Pos('%2', URL);
  258.             while j > 0 do
  259.             begin
  260.                if URL[j + 2] = 'e' then URL := Copy(URL, 1, j - 1) + '.' + Copy(URL, j + 3, 9999) else
  261.                if URL[j + 2] = 'f' then URL := Copy(URL, 1, j - 1) + '/' + Copy(URL, j + 3, 9999);
  262.                j := Pos('%2', URL);
  263.             end;
  264.          end;
  265.  
  266.          if FFiles.IndexOf(URL) < 0 then
  267.          begin
  268.             FFiles.Add(URL, Attrib, DT, Size, '', '', '','');
  269.             if Assigned(FSearchInfoEvent) then FSearchInfoEvent(Self, searchFileFound, URL);
  270.          end;
  271.       end;
  272.  
  273.       if i mod 25 = 0 then Application.ProcessMessages;
  274.    end;
  275. end;
  276.  
  277. procedure TMFtpSearch.Search;
  278. var i, j: Integer;
  279.     RFile: String;
  280.     Port: Integer;
  281. begin
  282.    if FBusy then Exit;
  283.    if Trim(FFile) = '' then Exit;
  284.  
  285.    FBusy := True;
  286.    RFile := BuildURL;
  287.    FFiles.Clear;
  288.  
  289.    for i := 0 to FServer.Count - 1 do
  290.    begin
  291.       FServer[i] := Trim(FServer[i]);
  292.  
  293.       if Trim(FServer[i]) <> '' then
  294.       begin
  295.          j := Pos(':', FServer[i]);
  296.  
  297.          if j > 0 then
  298.             Port := StrToInt(Copy(FServer[i], j + 1, 999))
  299.          else
  300.             Port := 80;
  301.  
  302.          if Assigned(FSearchInfoEvent) then
  303.             FSearchInfoEvent(Self, searchStart, FServer[i]);
  304.  
  305.          with TMFtpSearchThread.Create(RFile, Copy(FServer[i], 1, j - 1),
  306.                                        Port, FCache, FProxy) do
  307.          begin
  308.             Tag := i;
  309.             OnData := ThreadData;
  310.             FreeOnTerminate := True;
  311.             Execute;
  312.          end;
  313.       end;
  314.    end;
  315.  
  316.    FBusy := False;
  317. end;
  318.  
  319. procedure TMFtpSearch.ThreadData;
  320. var TS: TStringList;
  321. begin
  322.    TS := TStringList.Create;
  323.    try
  324.       TS.Text := Data;
  325.       Parse(TS);
  326.    finally
  327.       FreeAndNil(TS);
  328.    end;
  329.  
  330.    if Assigned(FSearchInfoEvent) then
  331.       FSearchInfoEvent(Self, searchDone, FServer[Tag]);
  332. end;
  333.  
  334. end.
  335.  
  336.