SRL Archive - Research & Development Lounge

Downloads an image from the internet.

{*******************************************************************************
function DownloadImage(URL, Path : string; Overwrite : boolean) : boolean;
By: Da 0wner
Description: Downloads an image to the specified path.
*******************************************************************************}

function DownloadImage(URL, Path : string; Overwrite : boolean) : boolean;
var
  FileNum, i : integer;
  Types : TStringArray;
  s : string;
begin
  Types := ['.png', '.bmp', '.gif', '.jpg', '.jpeg', '.jng', '.mng', '.pcx'];
  URL := lowercase(URL);
  Path := lowercase(Path);
  for i := 0 to high(Types) do
  begin
    if ((EndsWith(Types[i], URL)) and (EndsWith(Types[i], Path))) then
    begin
      if ((not FileExists(Path)) or (Overwrite)) then
      begin
        s := GetPage(URL);
        if s = '' then exit;
        FileNum := RewriteFile(Path, true);
        WriteFileString(FileNum, s);
        CloseFile(FileNum);
        if FileExists(Path) then result := true;
        exit;
      end;
    end;
  end;
end;

Does not download if the file already exists. Returns true if file was downloaded.

I dont really know how useful this will be, but not a bad idea.

It's useful for me :p.
In forms when you want to have an image there but it is a big bitmap then this will save a LOT more space.

works great ;D now if you could find a way to upload pictures to sites..

xD

That's easy I could do that. Would pose many security threats though.

Couldn't you make an option for the extension type? So it doesn't have to be just bmps?

Looks useful though. You could use it for downloading large bmps so you don't have to put all that messy and ugly bitmap code into the script

Yea, that's exactly what it's used for. And you can't open or use other image types other than bitmap.

Right, my bad. Regardless, good job. Might use this if I make a sexy photo form :D

Ok :). You can credit or not it dosen't matter ;).

Or you could convert the bitmap to string and then download the string and make a bitmap from that. That way, you don't even have to save it on the local hard drive.

I'll test that to see if it works.

Edit: Can't do that because I forgot the function to get the height/width of it.

You can always mod the string to include the width and height at the beginning, e.g.
image is 10 x 10 and changes to abcdefgh. you turn it into 10,10,abcedfgh then when you download it you explode it based on the , then set the width and height to the 1st and 2nd arrays then the image to the last. Of course, you can use whatever separator you want or in a different way, this makes sense to me though.

Yea, I understand now ;).

function DownloadImage(URL, Path, TypeOf : string) : boolean;
var
  FileNum : integer;
begin
  if (EndsWith('.'+ TypeOf, URL) and EndsWith('.'+ TypeOf, Path)) then
  begin
    if not FileExists(Path) then
    begin
      FileNum := RewriteFile(Path, true);
      WriteFileString(FileNum, GetPage(URL));
      CloseFile(FileNum);
    end;
    if FileExists(Path) then result := true;
  end;
end;

//e.g: DownloadImage('http://google.com/haha.png', 'c:\asd\', 'png');
//could even add detection

Simply added multiple stuff support. Could make a big loop to l33ch websites lol.

EDIT;
With type detection;

Function DownloadImage(URL, Path : String) : Boolean;
Var
  FileNum, i : Integer;
  Types      : TStringArray;
  TypeOf     : String;
Begin
  Types := ['png', 'jpg', 'bmp', 'gif'];
  For i := 0 To High(Types) Do
  Begin
    If Pos(Types[i], URL) <> 0 Then
    Begin
      TypeOf := Types[I];
      Break;
    End;
  End;
  If (EndsWith('.'+ TypeOf, URL) And EndsWith('.'+ TypeOf, Path)) Then
  Begin
    If Not FileExists(Path) Then
    Begin
      FileNum := RewriteFile(Path, True);
      WriteFileString(FileNum, GetPage(URL));
      CloseFile(FileNum);
    End;
    If FileExists(Path) Then Result := True;
  End;
End;

Wtf, I swear I thought SCAR could only handle bitmaps. Lol. Well Floor your example wouldn't work ;) because you need to add 'C:\asd\blah.png' or w/e as the path.

Well I guess I got it mixed up where SCAR could only FIND and place bitmaps on a form. But it can still download them as all it is doing is finding the source :).

Edit: Yours will work but it wouldn't be really reliable since your thing checks if the type is in the path/URL ANYWHERE and not just at the end. ;)

Also, to keep up with your guys stuff I made another one with auto detection…

{*******************************************************************************
function DownloadImage(URL, Path : string; Overwrite : boolean) : boolean;
By: Da 0wner
Description: Downloads an image to the specified path.
*******************************************************************************}

function DownloadImage(URL, Path : string; Overwrite : boolean) : boolean;
var
  FileNum, i : integer;
  Types : TStringArray;
begin
  Types := ['.png', '.bmp', '.gif', '.jpg', '.jpeg', '.jng', '.mng', '.pcx'];
  URL := lowercase(URL);
  Path := lowercase(Path);
  for i := 0 to high(Types) do
  begin
    if ((EndsWith(Types[i], URL)) and (EndsWith(Types[i], Path))) then
    begin
      if ((not FileExists(Path)) or (Overwrite)) then
      begin
        if GetPage(URL) = '' then exit;
        FileNum := RewriteFile(Path, true);
        WriteFileString(FileNum, GetPage(URL));
        CloseFile(FileNum);
        if FileExists(Path) then result := true;
        exit;
      end;
    end;
  end;
end;

I had to make mines without SCAR =[ I was running a script so I couldn't test it.

Yea. There was only an error in your example I believe. So good job :). May I have your msn?

From: Da 0wner
Yea. There was only an error in your example I believe. So good job :). May I have your msn?

Share the credits?
That my friend is the first thing you have to think about.
At least in your case.

~Hermpie

What are you talking about?

That I came with the idea of more extensions I guess. idc about credits for this one ;)

I know but you add the credits, and then if someone says (in this case Floor) "I don't need credits" then you remove them.
Since if someone helps you and he thinks he has done a great uber great job and wants credits and for the helped person it means almost nothing and doesn't add credits.

Then you have a problem, AFAIK.
This was a very specified situation. This was less worse(yours).

I don't want to annoy you, I saw you were new and I still learn things everyday about SRL and the COMMUNITY, just gave some advice ;).

~Hermpie

Err, I have no clue what you are talking about…
What procedure required credits? He just edited my procedure or something. This is kinda old tbh. If you meant he should get credits himself, I don't see why he should..and if you meant he should credit me, then I don't really care. But it was my procedure in the first place and the one I made later was built from scratch not on top of his.

here, i suped it up for you:

EDIT: this actually can download any document, and save it as the same filetype

function DownloadFile(URL, Path: String; Overwrite, AutoExt: Boolean): Boolean;
var
  Ext, Data: String;
  P, F: Integer;
begin
  if(FileExists(Path) and (not(Overwrite))) then
    Exit;
  P:= LastPos('.', URL);
  Ext:= Copy(URL, P, Length(URL) - P + 1);
  Data:= GetPage(URL);
  if(Data = '') then
    Exit;
  try
    F:= RewriteFile(Copy(Path + Ext, 0, Length(Path) + (Integer(AutoExt) * Length(Ext))), False);
    if(F < 0) then
      Exit;
    WriteFileString(F, Data);
  except
    Writeln('Error: ' + ExceptionToString(ExceptionType, ExceptionParam));
  finally
    if(F >= 0) then
    begin
      CloseFile(F);
      Result:= True;
    end;
  end;
end;

Hah, nice. I was noob at this time (3 months ago lol).

I might make another one later. But I has homework :(.