1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:

unit picupl;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  IdExplicitTLSClientServerBase, IdFTP, ComCtrls, StdCtrls, FileCtrl, shellapi,jpeg,
  IdAntiFreezeBase, IdAntiFreeze;

type
  TForm1 = class(TForm)
    ftp: TIdFTP;
    content: TListBox;
    Kategorien: TLabel;
    Label1: TLabel;
    files: TListBox;
    dirupbt: TButton;
    newcat: TButton;
    ProgressBar1: TProgressBar;
    IdAntiFreeze1: TIdAntiFreeze;
    procedure ftpWork(ASender: TObject; AWorkMode: TWorkMode;
      AWorkCount: Integer);
    procedure ftpWorkBegin(ASender: TObject; AWorkMode: TWorkMode;
      AWorkCountMax: Integer);
    procedure newcatClick(Sender: TObject);
    procedure dirupbtClick(Sender: TObject);
    procedure contentDblClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure openchangeddir;
  private
    { Private-Deklarationen }
    procedure WMDROPFILES (var Msg: TMessage); message WM_DROPFILES;
    
  public
    { Public-Deklarationen }
  end;                               

var
  Form1: TForm1;
  data: TStringlist;
  number, ebene: Integer;
  STime: TDateTime;
  pfad, currentdir, lastdir: String;

implementation

{$R *.dfm}
function GetType(const Filename: String): String;
var Info: TSHFileInfo;
begin
  if SHGetFileInfo(PChar(Filename), 0, Info, SizeOf(Info), SHGFI_TYPENAME) <> 0 then
    Result := Info.szTypeName
  else
    Result := '';
end;


procedure Resizepicture(filename, anlass: string; width, height, number: integer);
var
  bmp:TBitmap;
  jpeg:TJpegImage;
begin
  Jpeg:=TJpegImage.Create;
  try
    jpeg.LoadFromFile(filename);
    bmp:=TBitmap.Create;
      try
        if jpeg.width>jpeg.Height then
         begin
           bmp.width:=width;
           bmp.height:=height;
         end
        else
         begin
           bmp.width:=height;
           bmp.Height:=width;
         end;
        bmp.canvas.StretchDraw(Rect(0,0,bmp.width,bmp.height),jpeg);
        jpeg.assign(bmp);
      finally
        bmp.free;
      end;
      if ((width = 640) or (width = 480)) then
      jpeg.SavetoFile(pfad+'temp/'+anlass+'_' + inttostr(number)+'_img.JPG')
      else
      jpeg.SavetoFile(pfad+'temp/'+anlass+'_' + inttostr(number)+'_thb.JPG');
  finally
    jpeg.free;
  end;
end;


function GetFileSize(const szFile: String): Int64;
var
  fFile: THandle;
  wfd: TWIN32FINDDATA;
begin
  result := 0;
  if not FileExists(szFile) then exit;
  fFile := FindFirstfile(pchar(szFile),wfd);
  if fFile = INVALID_HANDLE_VALUE then exit;
  result := (wfd.nFileSizeHigh*(MAXDWORD))+wfd.nFileSizeLow;
  windows.FindClose(fFile);
end;




procedure TForm1.WMDROPFILES (var Msg: TMessage);
var i, anzahl, size: integer;
anlass, up: String;
  Dateiname: PChar;
begin
anlass := inputbox('Anlass und Name','Bitte den Anlass und den Namen des Photographen eingeben! z.B.: "Point B Party - Martin"','Hier eingeben!');
if (anlass<>'Hier eingeben!') and (pos('.',anlass)=0) then
begin
  inherited;
  anzahl := DragQueryFile(Msg.WParam, $FFFFFFFF, Dateiname, 255);
  for i := 0 to (anzahl - 1) do
  begin
    size := DragQueryFile(Msg.WParam, i , nil, 0) + 1;
    Dateiname:= StrAlloc(size);
    DragQueryFile(Msg.WParam,i , Dateiname, size);
    showmessage(gettype(dateiname));
    if ((pos('.JPG',StrPas(Dateiname))<>0) or (pos('.JPEG',StrPas(Dateiname))<>0) or (pos('.jpeg',StrPas(Dateiname))<>0) or (pos('.jpg',StrPas(Dateiname))<>0)) then
          begin
              resizepicture(dateiname,anlass,640,480,i);
              ftp.Put(pfad+'temp\'+anlass+'_' + inttostr(i)+'_img.JPG');
              deletefile(pfad+'temp\'+anlass+'_' + inttostr(i)+'_img.JPG');
          end
    else showmessage('Dateityp nicht erlaubt!');

    StrDispose(Dateiname);
  end;
  for i := 0 to ebene-1 do
up := up+'../';
  ftp.ChangeDir(up+'../thb/'+currentdir);
  for i := 0 to (anzahl - 1) do
  begin
    size := DragQueryFile(Msg.WParam, i , nil, 0) + 1;
    Dateiname:= StrAlloc(size);
    DragQueryFile(Msg.WParam,i , Dateiname, size);
   if ((pos('.JPG',StrPas(Dateiname))<>0) or (pos('.JPEG',StrPas(Dateiname))<>0) or (pos('.jpeg',StrPas(Dateiname))<>0) or (pos('.jpg',StrPas(Dateiname))<>0)) then
          begin
              resizepicture(dateiname,anlass,80,60,i);
              ftp.Put(pfad+'temp\'+anlass+'_' + inttostr(i)+'_thb.JPG');
              deletefile(pfad+'temp\'+anlass+'_' + inttostr(i)+'_thb.JPG');
          end
    else showmessage('Dateityp nicht erlaubt!');

    StrDispose(Dateiname);
  end;
  ftp.ChangeDir(up+'../img/'+currentdir);
  DragFinish(Msg.WParam);
  ftp.RetrieveCurrentDir;
openchangeddir;
end
else
showmessage('Der Anlass enthält ungültige Zeichen (".") oder du hast vergessen einen einzugeben!');
end;

procedure TForm1.openchangeddir;
var i: Integer;
begin
content.Clear;
files.Clear;
ftp.list(data,'',false);
for i := 0 to data.Count-1 do
  begin
    if ((data.Strings[i]<>'.') and (data.Strings[i]<>'..') and (pos('.',data.Strings[i])=0))   then
     begin
     content.Items.add(data.strings[i]);
     end;
    if ((data.Strings[i]<>'.') and (data.Strings[i]<>'..') and (pos('.',data.Strings[i])<>0)) then
     files.Items.add(data.strings[i]);
  end;
end;


procedure TForm1.FormCreate(Sender: TObject);
var sub: String;
i: Integer;
begin
sub := paramstr(0);
i := pos('picuploader.exe',sub);
pfad := copy(sub,0,0+i-1);

dirupbt.Enabled := false;
ebene := 0;
DragAcceptFiles(Form1.Handle, true);
data := Tstringlist.Create;
ftp.connect;
ftp.ChangeDir('pub/php-files/gallerie/img');
openchangeddir;
end;

procedure TForm1.contentDblClick(Sender: TObject);
begin
ftp.ChangeDir(content.Items[content.itemindex]+'/');
lastdir := currentdir;
currentdir := currentdir+content.Items[content.itemindex]+'/';
openchangeddir;
ebene := ebene +1;
if ebene > 0 then
dirupbt.Enabled := true;


end;

procedure TForm1.dirupbtClick(Sender: TObject);
var i: Integer;
begin
i := pos(lastdir,currentdir);
currentdir := copy(currentdir,0,i-1);
ebene := ebene -1;   ftp.ChangeDirUp;  openchangeddir;
if ebene <= 0 then
dirupbt.Enabled := false
else
dirupbt.Enabled := true;
end;

procedure TForm1.newcatClick(Sender: TObject);
var name, up: String;
i :Integer;
begin
name := inputbox('Neue Kategorie', 'Hier bitte den neuen Namen eingeben!', 'Neu');
if ((name<>'Neu') and (pos('.',name)=0)) then
begin
ftp.MakeDir(name);
for i := 0 to ebene-1 do
up := up+'../';

ftp.MakeDir(up+'../thb/'+currentdir+name);
ftp.RetrieveCurrentDir;
openchangeddir;
end
else
showmessage('Der Name enthält ungültige Zeichen ("."), oder du hast vergessen einen einzugeben!');
end;

procedure TForm1.ftpWorkBegin(ASender: TObject; AWorkMode: TWorkMode;
  AWorkCountMax: Integer);
begin
STime := now;
progressbar1.Max := aworkcountmax;
progressbar1.Position :=0;
end;

procedure TForm1.ftpWork(ASender: TObject; AWorkMode: TWorkMode;
  AWorkCount: Integer);
begin
  ProgressBar1.Position := AWorkCount;

end;



end.					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:

unit kljbtool;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, Tabs, DockTabSet, IdBaseComponent,
  IdAntiFreezeBase, IdAntiFreeze, ComCtrls, TabNotBk, jpeg, shellapi,
  IdComponent, IdTCPConnection, IdTCPClient, IdExplicitTLSClientServerBase,
  IdFTP, inifiles;

type
  Tmain = class(TForm)
    Image1: TImage;
    Memo1: TMemo;
    tabs: TTabbedNotebook;
    IdAntiFreeze1: TIdAntiFreeze;
    pic_cats: TListBox;
    pics: TListBox;
    Label1: TLabel;
    Label2: TLabel;
    pic_up: TButton;
    pic_new_cat: TButton;
    progress: TProgressBar;
    pic_ftp: TIdFTP;
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure pic_ftpWork(ASender: TObject; AWorkMode: TWorkMode;
      AWorkCount: Integer);
    procedure pic_ftpWorkBegin(ASender: TObject; AWorkMode: TWorkMode;
      AWorkCountMax: Integer);
    procedure pic_new_catClick(Sender: TObject);
    procedure pic_upClick(Sender: TObject);
    procedure pic_catsDblClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure openchangeddir;
  private
    { Private-Deklarationen }
    procedure WMDROPFILES (var Msg: TMessage);
  public
    { Public-Deklarationen }
  end;

var
  main: Tmain;
  name, pfad, currentdir, lastdir: String;
  ebene: Integer;
  data: TStringlist;
  STime: TDatetime;
implementation

{$R *.dfm}

function GetFileSize(const szFile: String): Int64;
var
  fFile: THandle;
  wfd: TWIN32FINDDATA;
begin
  result := 0;
  if not FileExists(szFile) then exit;
  fFile := FindFirstfile(pchar(szFile),wfd);
  if fFile = INVALID_HANDLE_VALUE then exit;
  result := (wfd.nFileSizeHigh*(MAXDWORD))+wfd.nFileSizeLow;
  windows.FindClose(fFile);
end;
procedure Resizepicture(filename, anlass, name: string; width, height, number: integer);
var
  bmp:TBitmap;
  jpeg:TJpegImage;
begin
  Jpeg:=TJpegImage.Create;
  try
    jpeg.LoadFromFile(filename);
    bmp:=TBitmap.Create;
      try
        if jpeg.width>jpeg.Height then
         begin
           bmp.width:=width;
           bmp.height:=height;
         end
        else
         begin
           bmp.width:=height;
           bmp.Height:=width;
         end;
        bmp.canvas.StretchDraw(Rect(0,0,bmp.width,bmp.height),jpeg);
        jpeg.assign(bmp);
      finally
        bmp.free;
      end;
      if ((width = 640) or (width = 480)) then
      jpeg.SavetoFile(pfad+'temp/'+anlass+'-'+name+'_' + inttostr(number)+'_img.JPG')
      else
      jpeg.SavetoFile(pfad+'temp/'+anlass+'-'+name+'_' + inttostr(number)+'_thb.JPG');
  finally
    jpeg.free;
  end;
end;
procedure Tmain.WMDROPFILES (var Msg: TMessage);
var i, anzahl, size: integer;
anlass, up: String;
Dateiname: PChar;
begin
anlass := inputbox('Anlass und Name','Bitte den Anlass und den Namen des Photographen eingeben! z.B.: "Point B Party - Martin"','Hier eingeben!');
if (anlass<>'Hier eingeben!') and (pos('.',anlass)=0) then
  begin
    inherited;
    anzahl := DragQueryFile(Msg.WParam, $FFFFFFFF, Dateiname, 255);
    for i := 0 to (anzahl - 1) do
      begin
      size := DragQueryFile(Msg.WParam, i , nil, 0) + 1;
      Dateiname:= StrAlloc(size);
      DragQueryFile(Msg.WParam,i , Dateiname, size);
      if ((pos('.JPG',StrPas(Dateiname))<>0) or (pos('.JPEG',StrPas(Dateiname))<>0) or (pos('.jpeg',StrPas(Dateiname))<>0) or (pos('.jpg',StrPas(Dateiname))<>0)) then
          begin
          resizepicture(dateiname,anlass,name,640,480,i);
          pic_ftp.Put(pfad+'temp\'+anlass+'_' + inttostr(i)+'_img.JPG');
          deletefile(pfad+'temp\'+anlass+'_' + inttostr(i)+'_img.JPG');
          end
      else showmessage('Dateityp nicht erlaubt!');
      StrDispose(Dateiname);
  end;

for i := 0 to ebene-1 do
up := up+'../';

pic_ftp.ChangeDir(up+'../thb/' + currentdir);

for i := 0 to (anzahl - 1) do
  begin
  size := DragQueryFile(Msg.WParam, i , nil, 0) + 1;
  Dateiname:= StrAlloc(size);
  DragQueryFile(Msg.WParam,i , Dateiname, size);
  if ((pos('.JPG',StrPas(Dateiname))<>0) or (pos('.JPEG',StrPas(Dateiname))<>0) or (pos('.jpeg',StrPas(Dateiname))<>0) or (pos('.jpg',StrPas(Dateiname))<>0)) then
    begin
    resizepicture(dateiname,anlass,name,80,60,i);
    pic_ftp.Put(pfad+'temp\'+anlass+'_' + inttostr(i)+'_thb.JPG');
    deletefile(pfad+'temp\'+anlass+'_' + inttostr(i)+'_thb.JPG');
    end
    else showmessage('Dateityp nicht erlaubt!');

    StrDispose(Dateiname);
  end;

pic_ftp.ChangeDir(up+'../img/'+currentdir);
DragFinish(Msg.WParam);
pic_ftp.RetrieveCurrentDir;
openchangeddir;
end
else
showmessage('Der Anlass enthält ungültige Zeichen (".") oder du hast vergessen einen einzugeben!');
end;
procedure Tmain.openchangeddir;
var i: Integer;
begin
pics.Clear;
pic_cats.Clear;
pic_ftp.list(data,'',false);
for i := 0 to data.Count-1 do
  begin
    if ((data.Strings[i]<>'.') and (data.Strings[i]<>'..') and (pos('.',data.Strings[i])=0))   then
     begin
     pic_cats.Items.add(data.strings[i]);
     end;
    if ((data.Strings[i]<>'.') and (data.Strings[i]<>'..') and (pos('.',data.Strings[i])<>0)) then
     pics.Items.add(data.strings[i]);
  end;
end;
procedure Tmain.FormCreate(Sender: TObject);
var sub: String;
i: Integer;
begin
sub := paramstr(0);
i := pos('KLJB_Tools.exe', sub);
pfad := copy(sub,0,0+i-1);
pic_up.Enabled := false;
ebene := 0;
DragAcceptFiles(main.Handle, true);
data := Tstringlist.Create;
pic_ftp.Connect;
pic_ftp.ChangeDir('pub/php-files/gallerie/img');
openchangeddir;

end;
procedure Tmain.pic_catsDblClick(Sender: TObject);
begin
pic_ftp.ChangeDir(pic_cats.Items[pic_cats.itemindex]+'/');
lastdir := currentdir;
currentdir := currentdir+pic_cats.Items[pic_cats.itemindex]+'/';
openchangeddir;
ebene := ebene + 1;
if ebene > 0 then
pic_up.Enabled := true;
end;
procedure Tmain.pic_upClick(Sender: TObject);
var i: Integer;
begin
i := pos(lastdir,currentdir);
currentdir := copy(currentdir,0,i-1);
ebene := ebene - 1;
pic_ftp.changedirup;
openchangeddir;
if ebene <=0 then
pic_up.enabled := false
else
pic_up.Enabled := true;
end;
procedure Tmain.pic_new_catClick(Sender: TObject);
var name, up: String;
i :Integer;
begin
name := inputbox('Neue Kategorie', 'Hier bitte den neuen Namen eingeben!', 'Neu');
if ((name<>'Neu') and (pos('.',name)=0)) then
begin
pic_ftp.MakeDir(name);
for i := 0 to ebene-1 do
up := up+'../';

pic_ftp.MakeDir(up+'../thb/'+currentdir+name);
pic_ftp.RetrieveCurrentDir;
openchangeddir;
end
else
showmessage('Der Name enthält ungültige Zeichen ("."), oder du hast vergessen einen einzugeben!');
end;
procedure Tmain.pic_ftpWorkBegin(ASender: TObject; AWorkMode: TWorkMode;
  AWorkCountMax: Integer);
begin
STime := now;
progress.Max := aworkcountmax;
progress.Position :=0;
end;
procedure Tmain.pic_ftpWork(ASender: TObject; AWorkMode: TWorkMode;
  AWorkCount: Integer);
begin
progress.Position := aworkcount;
end;
procedure Tmain.FormClose(Sender: TObject; var Action: TCloseAction);
var ini: TIniFile;
begin
  ini:=TIniFile.create(ExtractFilePath(ParamStr(0))+
    'einstellungen.ini');
  ini.WriteString('Infos','Name',Name);
    ini.free;

end;
procedure Tmain.FormShow(Sender: TObject);
var ini: TIniFile;
begin
  ini:=TIniFile.create(ExtractFilePath(ParamStr(0))+
    'einstellungen.ini');
  try

    name:= ini.ReadString('Infos','Name','');
  finally
    ini.free;
  end;
  if name ='' then
  name := inputbox('Namen eingeben!','Bitte hier deinen richtigen Namen eingeben! Bitte keine Nicknamen!','[...]');
end;

end.