function TranslateCompletePath(Laufwerk, Pfad:
String):
string;
var
i: integer;
begin
if copy(Laufwerk,length(Laufwerk),1)='
\'
then delete(Laufwerk,length(Laufwerk),1);
if copy(pfad,1,1)<>'
/'
then pfad:='
/'+pfad;
for i:=0
to length(pfad)
do
if pfad[i]='
/'
then pfad[i]:='
\';
TranslateCompletePath:=Laufwerk+pfad;
end;
procedure TForm1.bttcdClick(Sender: TObject);
begin
if
bttcd.Caption = '
Connect'
then
begin
IdFTP1.Username := edusername.Text;
IdFTP1.Password := edpassword.Text;
IdFTP1.Host := edhost.Text;
bttcd.Caption := '
Disconnect';
IdFTP1.Connect;
IdFTP1.Login;
//IdFTP1.ChangeDir('files');
IdFTP1.List(FileListBox2.Items, '
', false);
end
else
begin
bttcd.Caption := '
Connect';
IdFTP1.Quit;
end
end;
procedure TForm1.bttsaveClick(Sender: TObject);
var
ini: tinifile;
begin
ini:=TIniFile.Create(ExtractFilePath(ParamStr(0)) + '
/settings/' + edname.Text);
try
ini.WriteString('
Client', '
Host', edhost.Text);
ini.WriteString('
Client', '
Username', edusername.Text);
ini.WriteString('
Client', '
Password', edpassword.Text);
finally
ini.Free;
Application.MessageBox('
Speichern erfolgreich abgeschlossen', '
Information', MB_OK
or MB_ICONINFORMATION);
Filelistbox1.Update;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
var i, b: Integer;
begin
i := FileListBox2.Count;
for b := 0
to i
do
FileListBox2.Items.Delete(0);
filelistbox1.ApplyFilePath((ExtractFilePath(ParamStr(0))) + '
settings');
filelistbox3.ApplyFilePath((ExtractFilePath(ParamStr(0))) + '
files');
Label2.Caption := '
Eigene IP: ' + IdHTTP1.Get('
http://olv.ol.funpic.de/ip.php');
progressbar1.Smooth := true;
end;
procedure TForm1.bttloadClick(Sender: TObject);
var
ini: tinifile;
begin
ini:=TIniFile.Create(ExtractFilePath(ParamStr(0)) + '
/settings/' + edname.Text);
try
edhost.Text := ini.ReadString('
Client', '
Host', '
');
edusername.Text := ini.ReadString('
Client', '
Username', '
');
edpassword.Text := ini.ReadString('
Clinet', '
Password', '
');
finally
ini.Free;
Application.MessageBox('
Laden erfolgreich abgeschlossen', '
Information', MB_OK
or MB_ICONINFORMATION);
end;
end;
procedure TForm1.bttssClick(Sender: TObject);
begin
if
bttss.Caption = '
Start'
then
begin
idftpserver1.active := true;
animate1.Active := true;
bttss.Caption := '
Stop';
end
else
begin
idftpserver1.active := false;
animate1.Active := false;
bttss.Caption := '
Start';
end;
end;
procedure TForm1.IdFTPServer1UserLogin(ASender: TIdFTPServerThread;
const AUsername, APassword:
string;
var AAuthenticated: Boolean);
begin
AAuthenticated := (AUsername = edUsername2.Text)
and (APassword = edPassword2.Text);
end;
procedure TForm1.bttuploadClick(Sender: TObject);
begin
IdFTP1.Put((ExtractFilePath(ParamStr(0)) + '
/files/' + edupload.Text), edupload.Text);
FileListbox1.Update;
end;
procedure TForm1.IdFTPServer1ListDirectory(ASender: TIdFTPServerThread;
const APath:
string; ADirectoryListing: TIdFTPListItems);
var LItem: TidFTPListItem;
tmp1: TSearchRec;
LFileAttribute: Integer;
LPfad:
String;
begin
LPfad := (ExtractFilePath(ParamStr(0)) + '
/shared/' + APath);
LFileAttribute := FILE_ATTRIBUTE_DIRECTORY + FILE_ATTRIBUTE_HIDDEN + FILE_ATTRIBUTE_SYSTEM;
if FindFirst(LPfad + '
*', LFileAttribute, tmp1) = 0
then
begin
repeat
if (tmp1.
Name <> '
.')
and (tmp1.
Name <> '
..')
then
begin
LItem := ADirectoryListing.Add;
LItem.FileName := tmp1.
Name;
LItem.Size := tmp1.Size;
LItem.OwnerName := '
Username';
LItem.GroupName := '
Groupname';
LItem.OwnerPermissions := '
rwx';
LItem.GroupPermissions := '
rwx';
LItem.UserPermissions := '
rwx';
if DirectoryExists(LPfad + tmp1.
Name)
then
LItem.ItemType := ditDirectory
else
LItem.ItemType := idftplist.ditFile;
end;
until FindNext(tmp1) <> 0;
end;
FindClose(tmp1);
end;
procedure TForm1.bttdownloadClick(Sender: TObject);
begin
IdFTP1.Get(eddownload.Text, (ExtractFilePath(ParamStr(0)) + '
/files/' + eddownload.Text), true)
end;
procedure TForm1.IdFTPServer1RetrieveFile(ASender: TIdFTPServerThread;
const AFileName:
string;
var VStream: TStream);
begin
VStream:=TFileStream.Create(translatecompletepath(ASender.HomeDir, AFileName), fmOpenRead
or fmShareExclusive ) ;
end;
procedure TForm1.IdFTPServer1StoreFile(ASender: TIdFTPServerThread;
const AFileName:
string; AAppend: Boolean;
var VStream: TStream);
begin
if FileExists( translatecompletepath(ASender.HomeDir, AFileName) )
and AAppend
then
begin
VStream:=TFileStream.Create(translatecompletepath(ASender.HomeDir, AFileName), fmOpenWrite
or fmShareExclusive ) ;
VStream.Seek( 0, soFromEnd ) ;
end
else
VStream := TFileStream.create(translatecompletepath( ASender.HomeDir, AFileName), fmCreate
or fmShareExclusive ) ;
end;
procedure TForm1.IdFTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCountMax: Integer);
begin
ProgressBar1.Max := AWorkCountMax;
ProgressBar1.Position := 0;
end;
procedure TForm1.IdFTP1Work(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCount: Integer);
begin
ProgressBar1.Position := AWorkCount;
end;
procedure TForm1.IdFTP1WorkEnd(Sender: TObject; AWorkMode: TWorkMode);
begin
ProgressBar1.Position := 0;
end;
procedure TForm1.FileListBox1DblClick(Sender: TObject);
begin
bttload.Click;
end;