unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,Wininet,Jpeg, ExtCtrls;
type
TForm1 = class(TForm)
Timer: TTimer;
procedure FormCreate(Sender: TObject);
procedure TimerTimer(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
mempic:TMemoryStream;
implementation
{$R *.dfm}
function DownloadURL(const aUrl: string): Boolean;
var
hSession: HINTERNET;
hService: HINTERNET;
lpBuffer: array[0..1024 + 1] of Char;
dwBytesRead: DWORD;
begin
Result := False;
// hSession := InternetOpen( 'MyApp', INTERNET_OPEN_TYPE_DIRECT, nil, nil, 0);
hSession := InternetOpen('MyApp', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
try
if Assigned(hSession) then
begin
hService := InternetOpenUrl(hSession, PChar(aUrl), nil, 0, 0, 0);
if Assigned(hService) then
try
mempic.Clear;
while True do
begin
dwBytesRead := 1024;
InternetReadFile(hService, @lpBuffer, 1024, dwBytesRead);
if dwBytesRead = 0 then break;
lpBuffer[dwBytesRead] := #0;
mempic.Write(lpBuffer,dwBytesRead);
end;
mempic.Seek(0,0);
Result := True;
finally
InternetCloseHandle(hService);
end;
end;
finally
InternetCloseHandle(hSession);
end;
end;
procedure TForm1.TimerTimer(Sender: TObject);
var jpg:TJPEGImage;
bmp:TBitmap;
begin
if DownloadURL('http://rga.ru/webcam/video.tmp') then
begin
beep;
bmp := TBitMap.Create;
Jpg := TJpegImage.Create;
Jpg.LoadFromStream(mempic);
bmp.Assign(Jpg);
Form1.Canvas.Draw(0,0,bmp);
bmp.free;
Jpg.free;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
mempic:=TMemoryStream.Create;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
mempic.free;
end;
end.