Ftp Bağlantı ve Ftpdeki Dosyaları Gösterme

[mrmarman]

Hocam seni anlıyorum ama kod satır sayısına takılmamak lazım, sadece ironi idi. Arkadaşımızın sonuca yaklaştım ifafesine istinaden ama yeterince altını çizememişim sanırım

Dilersen idftp'den yürüyen yeni bir bileşen sınıfı tanımlar tek satırlık olarak da sunabilirdim, o başka bir konu. Senin bunu bildiğini tahmin ettiğimdendir serzeniş de atarlandı de ne dersen işte.

Hevesi kırılmasın diye ilk adımı attırmaktı amaç. Çünkü sonrasında gele dosya isimleri, tarihleri, uzunlukları vs. vs. parse edecek ki asıl buradaki yaklaşımını merak ediyorum o kadar.

Bu işin sadece bir bileşen öğrenmek değil, beyni de çalıştırmak gerektiğini öğretmek için güzel bir proje seçmiş arkadaşımız bundan memnun oldum o kadar.

[true_false]

@donte http://www.indyproject.org/sockets/demos/index.en.aspx buradan IdFTP (FTP Client) yazan demoyu indir delphide aç bi çalıştır emin ol işin ucundan tutmuş olacaksın. Eğer ftp server yoksa aynı sayfadan ftp server indir onuda çalıştır.
FTP Konusundan bilginin az olduğunu varsayarak (affına sığınıyorum):
dosya transferi yapmaya yarayan protokoldür. ben genellikle client server mimarilerde paylaşım izin vs. gibi işlemlerle uğraşmamak için programlarıma FTP üzerinden dosya gönderip aldırıyorum lokal ağda paylaşım hızında çalışmaz ama izin paylaşım ve bilinçsiz bilgi işlem personeliyle uğraştırmaz.

sen ftp client işlemi yapacaksın ama deneme yapabilmek için bir adet çalışır bi ftp server'ın olması gerekiyor deneme bir web siten varsa onla kontrol et yoksa bilgisayarına bir server oluştur (yukarıdaki örneklerde ftp server var) yada
aşağıdaki uniti aynen al kopyala bu sana ftp server oluşturacak.

Kod: Tümünü seç

unit UntFTP;

interface
 uses
   Classes,
  windows,
  sysutils,
  IdFTPList,
  IdFTPServer,
  idtcpserver,
  IdSocketHandle,
  idglobal,
  IdHashCRC;

  type
  TFTPServer = class
  private
    { Private declarations }
    IdFTPServer: tIdFTPServer;
    homeDirectory:string;

    procedure IdFTPServer1UserLogin( ASender: TIdFTPServerThread; const AUsername, APassword: string ;var AAuthenticated: Boolean ) ;
    procedure IdFTPServer1ListDirectory( ASender: TIdFTPServerThread; const APath: string; ADirectoryListing: TIdFTPListItems ) ;
    procedure IdFTPServer1RenameFile( ASender: TIdFTPServerThread; const ARenameFromFile, ARenameToFile: string ) ;
    procedure IdFTPServer1RetrieveFile( ASender: TIdFTPServerThread; const AFilename: string; var VStream: TStream ) ;
    procedure IdFTPServer1StoreFile( ASender: TIdFTPServerThread; const AFilename: string; AAppend: Boolean; var VStream: TStream ) ;
    procedure IdFTPServer1RemoveDirectory( ASender: TIdFTPServerThread; var VDirectory: string ) ;
    procedure IdFTPServer1MakeDirectory( ASender: TIdFTPServerThread; var VDirectory: string ) ;
    procedure IdFTPServer1GetFileSize( ASender: TIdFTPServerThread; const AFilename: string; var VFileSize: Int64 ) ;
    procedure IdFTPServer1DeleteFile( ASender: TIdFTPServerThread; const APathname: string ) ;
    procedure IdFTPServer1ChangeDirectory( ASender: TIdFTPServerThread; var VDirectory: string ) ;
    procedure IdFTPServer1CommandXCRC( ASender: TIdCommand ) ;
    procedure IdFTPServer1DisConnect( AThread: TIdPeerThread ) ;
  protected
    function TransLatePath( const APathname, homeDir: string ) : string;
  public
    constructor Create( port:integer); reintroduce;
    function Connected(Asender:TIdFTPServerThread) : Boolean;
    destructor Destroy; override;
    procedure Active;
    procedure directory( dircc:String);
    function aktifmi:Boolean;
  end;

implementation

{ TFTPServer }


procedure TFTPServer.Active;
begin
  IdFTPServer.Active := true;
end;

function TFTPServer.aktifmi: Boolean;
begin
  Result := false;
  if IdFTPServer.Active = true then
  Result := True;
end;  

function TFTPServer.Connected(Asender: TIdFTPServerThread): Boolean;
begin
  Result := False;
  if Asender.Connection.Connected then
  Result := True;
end;

constructor TFTPServer.Create( port:integer);
begin
  IdFTPServer := tIdFTPServer.create( nil ) ;
  IdFTPServer.DefaultPort := port;

  IdFTPServer.AllowAnonymousLogin := False;
  IdFTPServer.EmulateSystem := ftpsUNIX;
  IdFTPServer.HelpReply.text := 'Help is not implemented';
  IdFTPServer.OnChangeDirectory := IdFTPServer1ChangeDirectory;
  IdFTPServer.OnChangeDirectory := IdFTPServer1ChangeDirectory;
  IdFTPServer.OnGetFileSize := IdFTPServer1GetFileSize;
  IdFTPServer.OnListDirectory := IdFTPServer1ListDirectory;
  IdFTPServer.OnUserLogin := IdFTPServer1UserLogin;
  IdFTPServer.OnRenameFile := IdFTPServer1RenameFile;
  IdFTPServer.OnDeleteFile := IdFTPServer1DeleteFile;
  IdFTPServer.OnRetrieveFile := IdFTPServer1RetrieveFile;
  IdFTPServer.OnStoreFile := IdFTPServer1StoreFile;
  IdFTPServer.OnMakeDirectory := IdFTPServer1MakeDirectory;
  IdFTPServer.OnRemoveDirectory := IdFTPServer1RemoveDirectory;
  IdFTPServer.Greeting.NumericCode := 220;
  IdFTPServer.OnDisconnect := IdFTPServer1DisConnect;


  with IdFTPServer.CommandHandlers.add do
  begin
    Command := 'XCRC';
    OnCommand := IdFTPServer1CommandXCRC;
  end;

  //IdFTPServer.Active := true;
end;

function CalculateCRC( const path: string ) : string;
var
  f: tfilestream;
  value: dword;
  IdHashCRC32: TIdHashCRC32;
begin
  IdHashCRC32 := nil;
  f := nil;
  try
    IdHashCRC32 := TIdHashCRC32.create;
    f := TFileStream.create( path, fmOpenRead or fmShareDenyWrite ) ;
    value := IdHashCRC32.HashValue( f ) ;
    result := inttohex( value, 8 ) ;
  finally
    f.free;
    IdHashCRC32.free;
  end;
end;

destructor TFTPServer.Destroy;
begin
IdFTPServer.free;
  inherited destroy;
end;
function GetSizeOfFile( const APathname: string ) : int64;
begin
  result := FileSizeByName( APathname ) ;
end;

function GetNewDirectory( old, action: string ) : string;
var
  a: integer;
begin
  if action = '../' then
  begin
    if old = '/' then
    begin
      result := old;
      exit;
    end;
    a := length( old ) - 1;
    while ( old[a] <> '\' ) and ( old[a] <> '/' ) do
      dec( a ) ;
    result := copy( old, 1, a ) ;
    exit;
  end;
  if ( action[1] = '/' ) or ( action[1] = '\' ) then
    result := action
  else
    result := old + action;
end;




procedure TFTPServer.directory(dircc: String);
begin
  homeDirectory := dircc;
end;

procedure TFTPServer.IdFTPServer1ChangeDirectory(
  ASender: TIdFTPServerThread; var VDirectory: string);
begin
 VDirectory := GetNewDirectory( ASender.CurrentDir, VDirectory ) ;
end;



procedure TFTPServer.IdFTPServer1CommandXCRC(ASender: TIdCommand);
var
  s: string;
begin
  with TIdFTPServerThread( ASender.Thread ) do
  begin
    if Authenticated then
    begin
      try
        s := ProcessPath( CurrentDir, ASender.UnparsedParams ) ;
        s := TransLatePath( s, TIdFTPServerThread( ASender.Thread ) .HomeDir ) ;
        ASender.Reply.SetReply( 213, CalculateCRC( s ) ) ;
      except
        ASender.Reply.SetReply( 500, 'file error' ) ;
      end;
    end;
  end;
end;

function StartsWith( const str, substr: string ) : boolean;
begin
  result := copy( str, 1, length( substr ) ) = substr;
end;

function BackSlashToSlash( const str: string ) : string;
var
  a: dword;
begin
  result := str;
  for a := 1 to length( result ) do
    if result[a] = '\' then
      result[a] := '/';
end;

function SlashToBackSlash( const str: string ) : string;
var
  a: dword;
begin
  result := str;
  for a := 1 to length( result ) do
    if result[a] = '/' then
      result[a] := '\';
end;

procedure TFTPServer.IdFTPServer1DeleteFile(ASender: TIdFTPServerThread;
  const APathname: string);
begin
 DeleteFile( pchar( TransLatePath( ASender.CurrentDir + '/' + APathname, ASender.HomeDir ) ) ) ;
end;

procedure TFTPServer.IdFTPServer1DisConnect(AThread: TIdPeerThread);
begin

end;

procedure TFTPServer.IdFTPServer1GetFileSize(ASender: TIdFTPServerThread;
  const AFilename: string; var VFileSize: Int64);
begin
 VFileSize := GetSizeOfFile( TransLatePath( AFilename, ASender.HomeDir ) ) ;
end;

procedure TFTPServer.IdFTPServer1ListDirectory(ASender: TIdFTPServerThread;
  const APath: string; ADirectoryListing: TIdFTPListItems);
 procedure AddlistItem( aDirectoryListing: TIdFTPListItems; Filename: string; ItemType: TIdDirItemType; size: int64; date: tdatetime ) ;
  var
    listitem: TIdFTPListItem;
  begin
    listitem := aDirectoryListing.Add;
    listitem.ItemType := ItemType;
    listitem.FileName := Filename;
    listitem.OwnerName := 'anonymous';
    listitem.GroupName := 'all';
    listitem.OwnerPermissions := '---';
    listitem.GroupPermissions := '---';
    listitem.UserPermissions := '---';
    listitem.Size := size;
    listitem.ModifiedDate := date;
  end;

var
  f: tsearchrec;
  a: integer;
begin
  ADirectoryListing.DirectoryName := apath;

  a := FindFirst( TransLatePath( apath, ASender.HomeDir ) + '*.*', faAnyFile, f ) ;
  while ( a = 0 ) do
  begin
    if ( f.Attr and faDirectory > 0 ) then
      AddlistItem( ADirectoryListing, f.Name, ditDirectory, f.size, FileDateToDateTime( f.Time ) )
    else
      AddlistItem( ADirectoryListing, f.Name, ditFile, f.size, FileDateToDateTime( f.Time ) ) ;
    a := FindNext( f ) ;
  end;

  FindClose( f ) ;
end;

procedure TFTPServer.IdFTPServer1MakeDirectory(ASender: TIdFTPServerThread;
  var VDirectory: string);
begin
   MkDir( TransLatePath( VDirectory, ASender.HomeDir ) ) ;
end;

procedure TFTPServer.IdFTPServer1RemoveDirectory(
  ASender: TIdFTPServerThread; var VDirectory: string);
begin
   RmDir( TransLatePath( VDirectory, ASender.HomeDir ) ) ;
end;

procedure TFTPServer.IdFTPServer1RenameFile(ASender: TIdFTPServerThread;
  const ARenameFromFile, ARenameToFile: string);
begin
   if not MoveFile( pchar( TransLatePath( ARenameFromFile, ASender.HomeDir ) ) , pchar( TransLatePath( ARenameToFile, ASender.HomeDir ) ) ) then
    RaiseLastWin32Error;
end;

procedure TFTPServer.IdFTPServer1RetrieveFile(ASender: TIdFTPServerThread;
  const AFilename: string; var VStream: TStream);
begin
VStream := TFileStream.create( translatepath( AFilename, ASender.HomeDir ) , fmopenread or fmShareDenyWrite ) ;
end;

procedure TFTPServer.IdFTPServer1StoreFile(ASender: TIdFTPServerThread;
  const AFilename: string; AAppend: Boolean; var VStream: TStream);
begin
  if FileExists( translatepath( AFilename, ASender.HomeDir ) ) and AAppend then
  begin
    VStream := TFileStream.create( translatepath( AFilename, ASender.HomeDir ) , fmOpenWrite or fmShareExclusive ) ;
    VStream.Seek( 0, soFromEnd ) ;
  end
  else
    VStream := TFileStream.create( translatepath( AFilename, ASender.HomeDir ) , fmCreate or fmShareExclusive ) ;
end;

procedure TFTPServer.IdFTPServer1UserLogin( ASender: TIdFTPServerThread;
  const AUsername, APassword: string;var AAuthenticated: Boolean ) ;
begin
  AAuthenticated := ( AUsername = 'deneme' ) and ( APassword = 'passdeneme' ) ;
  if not AAuthenticated then
    exit;

  ASender.HomeDir := homeDirectory;
  asender.currentdir := '/';
end;


function TFTPServer.TransLatePath(const APathname,
  homeDir: string): string;
var
  tmppath: string;
begin
  result := SlashToBackSlash( homeDir ) ;
  tmppath := SlashToBackSlash( APathname ) ;
  if homedir = '/' then
  begin
    result := tmppath;
    exit;
  end;

  if length( APathname ) = 0 then
    exit;
  if result[length( result ) ] = '\' then
    result := copy( result, 1, length( result ) - 1 ) ;
  if tmppath[1] <> '\' then
    result := result + '\';
  result := result + tmppath;
end;





end.

kullanımı:

Kod: Tümünü seç

uses ..... UntFTP;
...
.
.
.
.
.
.
/// butonun içine yaz.
var
fserver : TFTPServer;
begin
      fserver := TFTPServer.Create(21);
      fserver.directory('C:\DENEME');
      fserver.Active;
end;      

yukarıdaki kodu çalıştırdıktan sonra "localhost" (127.0.0.1)unda 21 numaralı portta "deneme" kullanıcı adı olan "passdeneme" şifresi olan c diskinde "DENEME" klasörü root directory olan bir ftpin olacak kontrol etmek için
borowser aç ve ftp://localhost:21 yaz entera bastığında sana kullanıcı adı şifre soruyorsa oldu bu iş.

ftp server tamamsa;
indy ftp client aç ve ve ilgili kutucuklara yukarıda verdiğim bilgileri yaz ve çalıştır eğer sıkıntı yoksa @mrmarman nın dediği gibi illüzyon sana kalmış.

[true_false]

@mrmarman bu sitede emin ol aramın bozuk olmasını istediğim en son kişisin çok büyük saygım var dediğim gibi kesinlikle polemik yaratmak değil niyetim. Sen nedersen odur. Tekrar Saygılar.

[mrmarman]

@mrmarman bu sitede emin ol aramın bozuk olmasını istediğim en son kişisin çok büyük saygım var dediğim gibi kesinlikle polemik yaratmak değil niyetim. Sen nedersen odur. Tekrar Saygılar.

Kardeşim benim. Aramız neden bozuk olsun. Tersine aynı şeyi ben söylüyorum. Hedef cevapların eğitici olması. Yoksa bize ne faydası var. Canın sağolsun. Kırıgınlık yok.

[csunguray]

Polemiğe girmek istemiyorum. Sadece bu forumun daha faydalı olması için gayret gösteriyorum.

Google araması ile edineceğin bir PDF bir kitap var. FTP bağlantısı ve Dosya işlemleri hakkında örnek projesi mevcut.Delphi ile programlamaya başlayanların mutlaka elinin altında olması gerekir.

diye cevap yazmak gerçek bir cevap vermekten çok aramaya devam etmeyi tavsiye eden bir cevap olmuş. Bir link verip "şu sayfadaki PDF dosyasını indirip 3. bölümü inceleyin"diye yazsaydınız gerçek ve faydalı bir cevap vermiş olurdunuz.

PDF içinde FTP diyerek arama yap istediğin konuya ulaşırsın. Okumak önemli değil burada okumaktan ziyade Hangi kod nerede, niçin kullanılmış bunu kavramaya çalış. kopyala yapıştır yapma. Sadece günü kurtarmış olursun. Biraz çaba istediğini elde edersin.Yaptığında da birazdaha iştahın kabarır severek yaparsın

burda da "aramaya devam et ama şöyle ara" türünden bir cevap olmuş. Bunun yerine doğrudan bir doküman veya sayfa adresi yazıp "bu dokümanı inceleyin" veya "bu sayfadaki örnek işinize yarar" deseydiniz gerçek bir cevap vermiş olurdunuz.

Indiy demolarinda ftp client demosunu incelemenizi oneririm. Internette indy demos diye aratin.

Bu cevapta da aramaya devam denilmiş. Bunun yerine "bilgisayarınızdak şu klasörde bulunan falan örneği inceleyin" deseydiniz gerçek ve faydalı bir cevap olurdu.

[xozcanx]

Polemiğe girmek istemiyorum. Sadece bu forumun daha faydalı olması için gayret gösteriyorum.

Google araması ile edineceğin bir PDF bir kitap var. FTP bağlantısı ve Dosya işlemleri hakkında örnek projesi mevcut.Delphi ile programlamaya başlayanların mutlaka elinin altında olması gerekir.

diye cevap yazmak gerçek bir cevap vermekten çok aramaya devam etmeyi tavsiye eden bir cevap olmuş. Bir link verip "şu sayfadaki PDF dosyasını indirip 3. bölümü inceleyin"diye yazsaydınız gerçek ve faydalı bir cevap vermiş olurdunuz.

PDF içinde FTP diyerek arama yap istediğin konuya ulaşırsın. Okumak önemli değil burada okumaktan ziyade Hangi kod nerede, niçin kullanılmış bunu kavramaya çalış. kopyala yapıştır yapma. Sadece günü kurtarmış olursun. Biraz çaba istediğini elde edersin.Yaptığında da birazdaha iştahın kabarır severek yaparsın

burda da "aramaya devam et ama şöyle ara" türünden bir cevap olmuş. Bunun yerine doğrudan bir doküman veya sayfa adresi yazıp "bu dokümanı inceleyin" veya "bu sayfadaki örnek işinize yarar" deseydiniz gerçek bir cevap vermiş olurdunuz.

Indiy demolarinda ftp client demosunu incelemenizi oneririm. Internette indy demos diye aratin.

Bu cevapta da aramaya devam denilmiş. Bunun yerine "bilgisayarınızdak şu klasörde bulunan falan örneği inceleyin" deseydiniz gerçek ve faydalı bir cevap olurdu.

Hocam önceki mesajlarda da belirtilmiş kimse burada Polemiğe girmek istemiyor. Herkesin öğrenme şekli ve öğretme şekli farklı, olaylara bakış açısı farklı bunun farkındayız. Bilgi seviyemden dolayı çok fazla yardım eden konumuda değilim ama elimden geldiğince birşeyler yapmaya çalışıyorum. Karşımızdaki kişiyi tanımdan cevaplar veriyoruz. Ne veren el alanı görüyor, ne de alan el vereni görüyor. Çok iyi bilirsiniz zamanında bir konu hakkında araştırma yapmak istediğimizde kütüphanelere gider bir sürü ansiklopedi karıştırırdık. Şuan durum böyle değil internete yaz cevabı al işin görülsün. Sadece bunu yazılım sektörü için söylemiyorum. Bu yüzden de Türkkiye olarak bilişim sektöründe geride kalıyoruz. Benim şahsi görüşüm biraz olsun araştıralım.

Umarım kendimizi ifade edebilmişimdir.

[true_false]

@csunguray öncelikle haklı olduğun konu şudur ki "internette ara bulursun" tarzı cevap evet kaliteli bir cevap değil Lakin google indy yazdıldığında bire ilk sırada sorulan sorunun cevabı geliyor. (Evet arkadaş bilemeyebilir, Haklısın ama en azından bi deneyebilir. Bazen ufacık bi keyword ile ne sorunlar çözdüğümü bilirim sıkıntı şuki bazen karşımızdakini kendimiz gibi düşünebiliyoruz. )

Foruma 2004 yılından beri çeyrek aktifim. Forum adabını az buçuk biliyorum @freeman35 'in cevap tarzını çok severim @mrmarman 'ında @freeman35 genelde kod parçacıklarıyla değil yöntemle cevap verir @mrmarman nokta atışlarından hoşlanır. Aslında programlama bilgisi olan birisine 2 tarzdada cevap vermek makuldur, yeterlidir, kafidir.

Son zamanlarda soru soran arkadaşlar nedense olsun bitsin cevaplar arıyor ki yok öyle bi dünya. forumun aktif yıllarında böyle bir soruya gerçekten çok acımasız cevaplar verilebilirdi. örneklerini çok gördüm. Sıkıntı şu soru soran arkadaşlar (belki birilerinin günahına giricem Allah afetsin.) programlama bilgisinden uzaklar.

2. cevabımda daha açıklayıcı cevap verdim. Ama biz (tabirimi maruz gör) burda birbirimizi yerken arkadaş ortada yok.

[xozcanx]

2. cevabımda daha açıklayıcı cevap verdim. Ama biz (tabirimi maruz gör) burda birbirimizi yerken arkadaş ortada yok.

Hocam Akşam Akşam ağlanacak halimize iyi güldüm Aynen dediğiniz gibi oldu galiba

[donte]

2. cevabımda daha açıklayıcı cevap verdim. Ama biz (tabirimi maruz gör) burda birbirimizi yerken arkadaş ortada yok.

Hocam Akşam Akşam ağlanacak halimize iyi güldüm Aynen dediğiniz gibi oldu galiba

Kusurabakmayın arkadaşlar. Forumda Login olduğum saatlere dikkat ederseniz akşam 8 den sonra olduğunu görebilirsiniz. Bunun sebebi ise işyerimizden 2 kişinin ani kararla istafa edip benim sabah saat 7 de başlayan işim ve akşam saat en erken 8-9 arası biten mesaimdir. Şuan saat 00.01 ve eve 15 dakika önce girdim. Başka birisi örnek verdimi diye veya bana akıl verdimi diye. Ama sizin verdiğiniz akılları kendi aranızda tartışma ortamına cevirmişiniz'ki ben hiç böyle bir yaklaşım istemedim. Sadece küçük örnekler istedim. Siz birbirinizi yemeniz benim kulağım senin kulağında büyük olayına girmiş biraz (affedersiniz.) Her cevap atana doğru veya yanlış. Teşekkürümü çok büyük bir yürek ile ettim. Forumdan kaçmadım. Eğer birgün öğrenirsem delphi'yi'ki (bu çalışmam ile çok zor) çok fazla zaman ayıramıyorum. Forumda herkese yardım etmek isterim. Forumda birçok konu gezdim soru soran arkadaşların cevaplarına bakıp birşeyler aradım. Şuan önümde 3 tane ayrı kaynaktan çıktı alarak oluşturduğum kitaplar var. Mantıkları hepsinin aynı. Bu böyle yapılır. Ben bunu öğrenirsem'ki öğrenemem görsel yok. Görsel herşeydir benim için. Şöyle düşünün, Bir iş yapıyorsunuz size yaptığınız iş karşısında Minnettar oluyorlar ve maaşınızı arttırıyorlar.. Çok hoşunuza gider ve daha fazla çalışmaya başlarsınız. Bunu şuraya çevirin. Ben bir buton oluşturup Merhaba Dünya yazdığımda bile hefesim biraz daha artıyor. Hazır kod evet ama o hazır kodu biryerden sonra ister istemez ezberliyorsunuz.
Tartışmaya gerek yok arkadaşlar,abiler, ablalar. Ama birisini tanımadan yargılamanız hiç iyi birşey değil. Neyse arkadaşlar yardım etmek isteyen arkadaşlar ellerinden gelen yardımı yapmışlar. Modorotor varsa konuyu kitlerse sevinirim kendi aramızda tartışmanın anlamı yok. Konu yardımdan çok tartışma platformuna dönmüş
Tekrardan herkese çok teşekkür ederim.