Thema: Delphi IdFTP Problem

Einzelnen Beitrag anzeigen

Benutzerbild von PhilmacFLy
PhilmacFLy

Registriert seit: 20. Jan 2008
Ort: Nürnberg
340 Beiträge
 
FreePascal / Lazarus
 
#1

IdFTP Problem

  Alt 17. Sep 2008, 20:50
Bin schon wieder mal beim coden auf ein für mich nicht lös bares Problem gestoßen.
Ich verscuhe momentan ein Filesahring Programm zu schreiben das zwischen 2 Clients direkt eine Verbindung herstellt über FTP, dabei stoß ich beim download auf dei Fehlermeldung die unten im Bild zu sehen ist. Auch das Uploaden bereitet mir Probleme da einfach nichts passiert. Hier der momentane Source Code:
Delphi-Quellcode:
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;
hat irgendwer ne idee?
Miniaturansicht angehängter Grafiken
2_528.jpg   1_293.jpg  
Philipp N.
"Programmiern ist wie küssen:
Mann kan darüber reden, mann kann es beschreiben,
aber man weiss erst, was es bedeutet,
wenn man es getan hat"
  Mit Zitat antworten Zitat