SRL Archive - Delphi/FPC Help and Tutorials

Quick Image Uploader


caused

2009-10-15 07:34:56

Just Rightclick your Images and select Upload. When it's done, you will have a link to that Image in your Clipboard.


666kb.com Image Uploader
========================

Installation:
-> Unpack the programme to where you want to install it.
-> Open 666kb.exe
-> Click Install

You're done. You can now directly Upload Image files by right clicking them and choose "-> Upload Image".
the link to the Image will be pasted in your Clipboard. Max Filesize is 666kb.

A list of your uploaded Files is generated in the us.ini file(located the same folder as your 666kb.exe).

Have fun =)


The hardest part actually was to create the entry in the context menu ;D.
I altered the "Demos/activex/shellext/" code for that purpose. So thats what the dll is made from.

Feedback welcome ;D. I'd also like to know if this works with Vista, cause its writing in the registry, which may require certain permissions.


Source:

unit uploader;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,Idhttp, StdCtrls,IdMultiPartFormData,Clipbrd,IniFiles,DateUtils,Registry,
ExtCtrls;

type
TForm1 = class(TForm)
Label1: TLabel;
Button1: TButton;
Memo1: TMemo;
Label2: TLabel;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Image1: TImage;
Label3: TLabel;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Label3Click(Sender: TObject);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}




function CheckIfValid(testsite : string):integer;
begin

If Pos('URL der gespeicherten Bilddatei',testsite) > 0 then
begin
result := 1;
exit;
end;

If Pos('Das war keine Bilddatei!', testsite) > 0 then
begin
result := 2;
exit;
end;

end;

function ExtractImageUrl(testsite : string):string;
begin
Delete(testsite,1,Pos('URL der gespeicherten Bilddatei: <a href="', testsite)+strlen('URL der gespeicherten Bilddatei: <a href="')-1);
Result:= Copy(testsite,0,Pos('"',testsite)-1);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
uploadit : Tidhttp;
thesite : string;
PostData : TIdMultipartFormDataStream;
begin
uploadit := Tidhttp.Create(nil);
uploadit.HandleRedirects := TRUE;
try
PostData := TIdMultipartFormDataStream.Create;

PostData.AddFormField('MAX_FILE_SIZE','681984');
PostData.AddFile('f',ParamStr(1),'image/jpeg');
PostData.AddFormField('optimize','0');


thesite:=uploadit.Post('http://666kb.com/u.php',PostData);
except
end;

uploadit.Free;


case CheckIfValid(thesite) of
1: Clipboard.AsText := ExtractImageUrl(thesite);
2: showmessage('Das war keine Bilddatei!'+#10+#13+'(oder es gab einen Fehler bei der Übertragung - zu groß?)');
else
ShowMessage('Datei zu Groß / Unbekannter Fehler');
end;

memo1.Text := thesite;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
urlc : TClipboard;
begin
ShowMessage(ParamStr(1));
Clipboard.AsText := ParamStr(1);

end;

procedure AddToRegistry;
var regist: TRegistry;
begin
regist:=TRegistry.Create;
try
regist.RootKey:=HKEY_LOCAL_MACHINE;
regist.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\666kb.exe', true);
regist.WriteString('', ParamStr(0));
regist.WriteString('Path', ExtractFilePath(ParamStr(0)));
finally
regist.free;
end;
end;

procedure RemoveFromRegistry;
var regist: TRegistry;
begin
regist:=TRegistry.Create;
try
regist.RootKey:=HKEY_LOCAL_MACHINE;
regist.DeleteKey('SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\666kb.exe');
finally
regist.free;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
uploadit : Tidhttp;
thesite : string;
PostData : TIdMultipartFormDataStream;

ini : TiniFile;
mydll : string;

CurrentDate : string;
begin
Form1.Visible := False;
If paramstr(1) = '' then begin
Form1.Visible := True;
Form1.Left := 388;
Form1.Top := 210;
exit;
end;


ini:=TIniFile.create(ExtractFilePath(ParamStr(0))+'us.ini');

//Uploading Image and returning Location
uploadit := Tidhttp.Create(nil);
uploadit.HandleRedirects := TRUE;
try
PostData := TIdMultipartFormDataStream.Create;

PostData.AddFormField('MAX_FILE_SIZE','681984');
PostData.AddFile('f',ParamStr(1),'image/jpeg');
PostData.AddFormField('optimize','0');


thesite:=uploadit.Post('http://666kb.com/u.php',PostData);
except
end;

uploadit.Free;

case CheckIfValid(thesite) of
1:
begin
Clipboard.AsText := ExtractImageUrl(thesite);
CurrentDate := DateTimeToStr(Now);
ini.WriteString('Uploaded Files',CurrentDate,ExtractImageUrl(thesite));
end;
2: showmessage('Das war keine Bilddatei!'+#10+#13+'(oder es gab einen Fehler bei der Übertragung - zu groß?)');
else
ShowMessage('Datei zu Groß / Unbekannter Fehler');
end;

memo1.Text := thesite;
ini.WriteString('Run','FirstRun','False');
ini.free;
Application.Terminate;
end;

procedure TForm1.Button3Click(Sender: TObject);
var
uploadit : Tidhttp;
thesite : string;
PostData : TIdMultipartFormDataStream;

ini : TiniFile;
mydll : string;

CurrentDate : string;
begin
//Ini Management
ini:=TIniFile.create(ExtractFilePath(ParamStr(0))+
'us.ini');

mydll := ExtractFilePath(ParamStr(0))+'u666kb.dll';

if not (ini.ReadString('Run','Firstrun','') = 'False') then // Register dll file
begin
try
AddToRegistry;
WinExec(Pchar('regsvr32 '+'"'+mydll+'"'),0);
finally
ini.WriteString('Run','FirstRun','False');
ShowMessage('Installation Successful!'+#10+#13+'You can now upload pictures by using the context menu'+#10+#13+'A link to the uploaded pic will be placed in your clipboard than.');
Application.Terminate;
end
end else
label2.WordWrap := TRUE;
label2.Width := 170;
ShowMessage('Programme already installed. If you want to reinstall it, remove the us.ini file.');

end;

procedure TForm1.Button4Click(Sender: TObject);
var
uploadit : Tidhttp;
thesite : string;
PostData : TIdMultipartFormDataStream;

ini : TiniFile;
mydll : string;

CurrentDate : string;
begin
//Ini Management
ini:=TIniFile.create(ExtractFilePath(ParamStr(0))+
'us.ini');

mydll := ExtractFilePath(ParamStr(0))+'u666kb.dll';

if ini.ReadString('Run','Firstrun','') = 'False' then // Register dll file
begin
try
RemoveFromRegistry;
WinExec(Pchar('regsvr32 /u '+'"'+mydll+'"'),0);
finally
ini.WriteString('Run','FirstRun','True');
ShowMessage('Programme uninstalled succesfully.');
Application.Terminate;
end
end else
label2.WordWrap := TRUE;
label2.Width := 170;
ShowMessage('Cant Uninstall. Programme is not installed');

end;

procedure TForm1.Label3Click(Sender: TObject);
begin
Application.Terminate;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
xmove : integer;
begin
ReleaseCapture;
Perform(WM_SYSCOMMAND, $F012, 0);
end;

end.

Have fun :D

Dervish

2009-10-15 12:55:07

Edited xD.

Really sexy, does it support all formats ? From JPG to Tiff ?

caused

2009-10-15 13:00:56

From: Dr D. Dervish
Edited xD.

Really sexy, does it support all formats ? From JPG to Tiff ?


Thanks for testing !. It supports: Jpg, Jpeg, bmp, gif and png.

I will probably add more uploader, and maybe even support for larger non-image files (which would require other hoster, like rapdishare, megaupload…) with a status bar for files bigger than 2 mb.

~caused

Dervish

2009-10-15 13:03:22

From: caused
Thanks for testing !. It supports: Jpg, Jpeg, bmp, gif and png.

I will probably add more uploader, and maybe even support for larger non-image files (which would require other hoster, like rapdishare, megaupload…) with a status bar for files bigger than 2 mb.

~caused


But where does it upload them to ? :huh:

caused

2009-10-15 13:04:53

From: Dr D. Dervish
But where does it upload them to ? :huh:


strg+v ;). It also has a list of already uploaded files in the "us.ini" file which is generated after installation in the same folder as 666kb.exe.

YoHoJo

2009-10-15 14:04:33

This is a very awesome and useful tool, great idea! Right click upload is very very handy!

Dervish

2009-10-15 15:02:19


Testing…

Works great ! :)

Make an option to make it have

caused

2009-10-15 17:41:11

I will do that, Dr D. Dervish.
Also adding support for more ImageHoster and 1 or 2 FileHoster.

Any suggestion which hoster I shall add ?

~caused

Dervish

2009-10-16 01:26:36

From: caused
I will do that, Dr D. Dervish.
Also adding support for more ImageHoster and 1 or 2 FileHoster.

Any suggestion which hoster I shall add ?

~caused


I really don't know :p.

Tinypic and Imageshack sucks, just don't use them and it'll be fine :p.

Harry

2009-10-16 02:01:48

Write a version that'll work on GNU/Linux please? :O

caused

2009-10-16 05:53:52

From: Harry
Write a version that'll work on GNU/Linux please? :O


haha ; D. Well I have no Idea how the X-Window System excactly works, and how I'd implement new entries for certain files in the context menu( I already had trouble realising this in windows)

Other than that is my delphi for windows too ;). But feel free to make a linux version.

~caused

Harry

2009-10-16 05:56:51

Well, you can use the commands `scrot` and probably a few curl commands in a .sh script for GNU/Linux :3

caused

2009-10-16 07:47:44

From: Harry
Well, you can use the commands `scrot` and probably a few curl commands in a .sh script for GNU/Linux :3


Isn't it different for every window manager ?

I currently don't got any linux distribution running (Reason: Compatibility issues with my hardware and software). But I'd gladly release a linux version, which would probably be java-based, since i don't think linux supports the win-api, which delphi uses alot.

Or maybe Kylix, but i never used that. Oh and it seems to be old. Maybe rather Lazarus, hehe =)

~caused

fronty

2009-10-16 15:28:04

I think taking screenshots with scrot should work same way with every wm. At least IIRC it should be implementable with plain Xlib.

caused

2009-10-16 16:30:46

From: fronty
I think taking screenshots with scrot should work same way with every wm. At least IIRC it should be implementable with plain Xlib.


Who's talking about screenshots :P?

fronty

2009-10-16 16:50:52

I just checked only last post, and your quote just contained sentence about scrot and curl. Curl has nothing to do with windowing, and scrot is utility for taking screenshots. I just checked from freshmeat, and according to that it doesn't have other functionality, but I was still wrong, because it doesn't use Xlib. So when you said that something depends on wm, I understood that you meant usage and/or functionality of scrot. My bad.

EvilChicken!

2009-10-17 09:17:40

This is pretty cool.

Nice work, caused!

minoudz

2011-06-08 01:24:04

thank you

bolshak25

2011-06-08 16:09:02

please refrain from gravedigging, being this is an old thread. also messages like thank you are spam.

Sex

2011-06-08 16:29:31

From: bolshak25
please refrain from gravedigging, being this is an old thread. also messages like thank you are spam.

Instead of continuing to post, just report his post and a moderator will come in.
Nevertheless, this is a cool tool and I didn't see it when it was posted, so thanks for bumping it!