delphi Code:
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.