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;
Button5: TButton;
Button6: TButton;
Button7: TButton;
Button8: TButton;
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.