home *** CD-ROM | disk | FTP | other *** search
/ PC Open 19 / pcopen19.iso / Zipped / CALMIR21.ZIP / SOURCE.ZIP / VCL / INTERNET.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-02-20  |  3.3 KB  |  149 lines
  1. {*********************************************************}
  2. {                                                         }
  3. {    Calmira Visual Component Library 2.1                 }
  4. {    by Li-Hsin Huang,                                    }
  5. {    released into the public domain January 1998         }
  6. {                                                         }
  7. {*********************************************************}
  8.  
  9. unit Internet;
  10.  
  11. interface
  12.  
  13. uses
  14.   Classes, DdeMan;
  15.  
  16. type
  17.   TBrowserLink = class(TDdeClientConv)
  18.   private
  19.     function BeginExchange(const NewTopic: string): Boolean;
  20.   protected
  21.   public
  22.     constructor Create(AOwner: TComponent); override;
  23.     function IsBrowserLoaded : Boolean;
  24.     function ActivateBrowser: Boolean;
  25.     function CaptureLocation(var Title, Url: OpenString): Boolean;
  26.     function OpenURL(const Url: string): Boolean;
  27.   end;
  28.  
  29. const
  30.   URLPrefixes : string = 'http:// ftp:// gopher:// news: file: mailto:';
  31.  
  32. function IsURL(const s: string): Boolean;
  33.  
  34. procedure Register;
  35.  
  36. implementation
  37.  
  38. uses
  39.   WinProcs, WinTypes, SysUtils, Strings, MiscUtil;
  40.  
  41.  
  42. function IsURL(const s: string): Boolean;
  43. var temp: string;
  44. begin
  45.   temp := URLPrefixes;
  46.   Result := True;
  47.   while temp > '' do if Pos(GetWord(temp, ' '), s) = 1 then Exit;
  48.   Result := False;
  49. end;
  50.  
  51.  
  52. constructor TBrowserLink.Create(AOwner: TComponent);
  53. begin
  54.   inherited Create(AOwner);
  55.   ConnectMode := ddeManual;
  56. end;
  57.  
  58.  
  59. function TBrowserLink.BeginExchange(const NewTopic: string): Boolean;
  60. begin
  61.   ShowHourGlass;
  62.   SetLink(ExtractFilename(ServiceApplication), NewTopic);
  63.   Result := OpenLink;
  64. end;
  65.  
  66.  
  67. function TBrowserLink.ActivateBrowser: Boolean;
  68. begin
  69.   Result := BeginExchange('WWW_Activate');
  70.   if Result then
  71.   try
  72.     StrDispose(RequestData('0xFFFFFFFF,0x0'));
  73.   finally
  74.     CloseLink;
  75.   end;
  76. end;
  77.  
  78. function TBrowserLink.OpenURL(const Url: string): Boolean;
  79. begin
  80.   Result := ActivateBrowser and BeginExchange('WWW_OpenURL');
  81.   if Result then
  82.   try
  83.     StrDispose(RequestData(Format('"%s",,0xFFFFFFFF,0x0,,,,', [Url])));
  84.   finally
  85.     CloseLink;
  86.   end;
  87. end;
  88.  
  89.  
  90. var
  91.   FoundModule : Boolean;
  92.  
  93.  
  94. function FindBrowser(Wnd: HWnd; Filename: PChar): Bool; export;
  95. var
  96.   buf : array[0..127] of char;
  97. begin
  98.   GetModuleFilename(GetWindowWord(Wnd, GWW_HINSTANCE), buf, 127);
  99.   FoundModule := StrIComp(Filename, buf) = 0;
  100.   Result := not FoundModule;
  101. end;
  102.  
  103. function TBrowserLink.IsBrowserLoaded : Boolean;
  104. var
  105.   buf : array[0..127] of Char;
  106. begin
  107.   FoundModule := False;
  108.   StrPCopy(buf, ServiceApplication + '.EXE');
  109.   EnumWindows(@FindBrowser, Longint(@buf));
  110.   Result := FoundModule;
  111. end;
  112.  
  113.  
  114. function TBrowserLink.CaptureLocation(var Title, Url: OpenString): Boolean;
  115. var
  116.   Data : PChar;
  117.   p: Integer;
  118. begin
  119.   Title := '';
  120.   Url := '';
  121.   Result := False;
  122.  
  123.   if not IsBrowserLoaded then Exit;
  124.  
  125.   Result := BeginExchange('WWW_GetWindowInfo');
  126.   if Result then
  127.   try
  128.     Data := RequestData('0xFFFFFFFF');
  129.     try
  130.       Unformat(StrPas(Data), '"%s","%s"', [@Url, High(URL), @Title, High(Title)]);
  131.       p := Pos('[', Title);
  132.       if p > 0 then Title := Copy(Title, p+1, Length(Title)-p-1);
  133.     finally
  134.       StrDispose(Data);
  135.     end;
  136.   finally
  137.     CloseLink;
  138.   end;
  139. end;
  140.  
  141.  
  142. procedure Register;
  143. begin
  144.   RegisterComponents('Samples',[TBrowserLink]);
  145. end;
  146.  
  147. end.
  148.  
  149.