Giriş Yap

**sadikacar60** · 22-03-2020, Saat: 23:32

evet hocam gözden kaçırmışım çalışıyor çok teşekkür eder saygılar sunarım.

**sadikacar60** · 23-03-2020, Saat: 09:56

kaynak olması bakımından kodlarıda paylaşayım.

server. kodları.

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
 Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, IdFTPServer,
 IdFTPList, IdFTPListOutput;

type

 { TForm1 }

 TForm1 = class(TForm)
   IdFTPServer1: TIdFTPServer;
   Label1: TLabel;
   procedure FormCreate(Sender: TObject);
   procedure IdFTPServer1ChangeDirectory(ASender: TIdFTPServerContext;
     var VDirectory: TIdFTPFileName);
   procedure IdFTPServer1DeleteFile(ASender: TIdFTPServerContext;
     const APathName: TIdFTPFileName);
   procedure IdFTPServer1GetFileSize(ASender: TIdFTPServerContext;
     const AFilename: TIdFTPFileName; var VFileSize: Int64);
   procedure IdFTPServer1ListDirectory(ASender: TIdFTPServerContext;
     const APath: TIdFTPFileName; ADirectoryListing: TIdFTPListOutput;
     const ACmd: String; const ASwitches: String);
   procedure IdFTPServer1MakeDirectory(ASender: TIdFTPServerContext;
     var VDirectory: TIdFTPFileName);
   procedure IdFTPServer1RemoveDirectory(ASender: TIdFTPServerContext;
     var VDirectory: TIdFTPFileName);
   procedure IdFTPServer1RetrieveFile(ASender: TIdFTPServerContext;
     const AFileName: TIdFTPFileName; var VStream: TStream);
   procedure IdFTPServer1StoreFile(ASender: TIdFTPServerContext;
     const AFileName: TIdFTPFileName; AAppend: Boolean; var VStream: TStream);
   procedure IdFTPServer1UserLogin(ASender: TIdFTPServerContext;
     const AUsername, APassword: string; var AAuthenticated: Boolean);
 private
 function ReplaceChars(APath: String): String;
 function GetSizeOfFile(AFile : String) : Integer;
 public

 end;

var
 Form1: TForm1;
 AppDir      : String;
implementation

{$R *.lfm}

{ TForm1 }



function TForm1.ReplaceChars(APath:String):String;
var
s:string;
begin
 s := StringReplace(APath, '/', '\', [rfReplaceAll]);
 s := StringReplace(s, '\\', '\', [rfReplaceAll]);
 Result := s;
end;

function TForm1.GetSizeOfFile(AFile : String) : Integer;
var
FStream : TFileStream;
begin
Try
FStream := TFileStream.Create(AFile, fmOpenRead);
Try
 Result := FStream.Size;
Finally
 FreeAndNil(FStream);
End;
Except
Result := 0;
End;
end;




procedure TForm1.IdFTPServer1UserLogin(ASender: TIdFTPServerContext;
 const AUsername, APassword: string; var AAuthenticated: Boolean);
begin
// We just set AAuthenticated to true so any username / password is accepted
// You should check them here - AUsername and APassword
// AAuthenticated := True;
if (AUsername='deneme') and (APassword='1234') then
   AAuthenticated:=True
   //??????
 else
   AAuthenticated:=False;
   //û????????
end;

procedure TForm1.IdFTPServer1StoreFile(ASender: TIdFTPServerContext;
 const AFileName: TIdFTPFileName; AAppend: Boolean; var VStream: TStream);
begin
  if not Aappend then
  VStream := TFileStream.Create(ReplaceChars(AppDir+AFilename),fmCreate)
else
  VStream := TFileStream.Create(ReplaceChars(AppDir+AFilename),fmOpenWrite)
end;

procedure TForm1.IdFTPServer1RetrieveFile(ASender: TIdFTPServerContext;
 const AFileName: TIdFTPFileName; var VStream: TStream);
begin
  VStream := TFileStream.Create(ReplaceChars(AppDir+AFilename),fmOpenRead);
end;

procedure TForm1.IdFTPServer1RemoveDirectory(ASender: TIdFTPServerContext;
 var VDirectory: TIdFTPFileName);

  Var
   LFile : String;
  begin
    LFile := ReplaceChars(AppDir + VDirectory);
    // You should delete the directory here.
    // TODO
end;

procedure TForm1.IdFTPServer1MakeDirectory(ASender: TIdFTPServerContext;
 var VDirectory: TIdFTPFileName);
begin
   if not ForceDirectories(ReplaceChars(AppDir + VDirectory)) then
 begin
   Raise Exception.Create('Unable to create directory');
 end;
end;

procedure TForm1.IdFTPServer1ListDirectory(ASender: TIdFTPServerContext;
 const APath: TIdFTPFileName; ADirectoryListing: TIdFTPListOutput;
 const ACmd: String; const ASwitches: String);

 var
LFTPItem :TIdFTPListItem;
SR : TSearchRec;
SRI : Integer;
begin
 //ADirectoryListing.DirFormat := doUnix;
 SRI := FindFirst(AppDir + APath + '\*.*', faAnyFile - faHidden - faSysFile, SR);
 While SRI = 0 do
 begin
   LFTPItem := ADirectoryListing.Add;
   LFTPItem.FileName := SR.Name;
   LFTPItem.Size := SR.Size;
   LFTPItem.ModifiedDate := FileDateToDateTime(SR.Time);
   if SR.Attr = faDirectory then
    LFTPItem.ItemType   := ditDirectory
   else
    LFTPItem.ItemType   := ditFile;
   SRI := FindNext(SR);
 end;
 FindClose(SR);
 SetCurrentDir(AppDir + APath + '\..');
end;

procedure TForm1.IdFTPServer1GetFileSize(ASender: TIdFTPServerContext;
 const AFilename: TIdFTPFileName; var VFileSize: Int64);

 Var
LFile : String;
begin
LFile := ReplaceChars( AppDir + AFilename );
try
If FileExists(LFile) then
  VFileSize :=  GetSizeOfFile(LFile)
else
  VFileSize := 0;
except
  VFileSize := 0;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  AppDir := ExtractFilePath(Application.Exename);
end;

procedure TForm1.IdFTPServer1ChangeDirectory(ASender: TIdFTPServerContext;
 var VDirectory: TIdFTPFileName);
begin
 ASender.CurrentDir := VDirectory;
end;

procedure TForm1.IdFTPServer1DeleteFile(ASender: TIdFTPServerContext;
 const APathName: TIdFTPFileName);
begin
 DeleteFile(ReplaceChars(AppDir+ASender.CurrentDir+'\'+APathname));
end;

end.

client kodları;

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
 Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, IdFTP,IdFTPList;

type

 { TForm1 }

 TForm1 = class(TForm)
   btnChangeDir: TButton;
   btnCreateDir: TButton;
   btnDosyaSil: TButton;
   btnMakeDir: TButton;
   Button1: TButton;
   btnGet: TButton;
   btnPut: TButton;
   Button2: TButton;
   btnDelete: TButton;
   btnFileexists: TButton;
   Button3: TButton;
   Button4: TButton;
   btnList: TButton;
   btnPut2: TButton;
   Button5: TButton;
   IdFTP1: TIdFTP;
   Label1: TLabel;
   ListBox1: TListBox;
   Memo1: TMemo;
   procedure btnChangeDirClick(Sender: TObject);
   procedure btnCreateDirClick(Sender: TObject);
   procedure btnDeleteClick(Sender: TObject);
   procedure btnDosyaSilClick(Sender: TObject);
   procedure btnFileexistsClick(Sender: TObject);
   procedure btnMakeDirClick(Sender: TObject);
   procedure btnPut2Click(Sender: TObject);
   procedure btnPutClick(Sender: TObject);
   procedure Button1Click(Sender: TObject);
   procedure btnGetClick(Sender: TObject);
   procedure Button2Click(Sender: TObject);
   procedure Button3Click(Sender: TObject);
   procedure Button4Click(Sender: TObject);
   procedure btnListClick(Sender: TObject);
   procedure Button5Click(Sender: TObject);
   procedure Memo1Change(Sender: TObject);
 private

 public

 end;

var
 Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
begin
 IdFTP1.Host:='127.0.0.1';
 IdFTP1.Username:='deneme';
 IdFTP1.Password:='1234';

 IdFTP1.Connect;

 if IdFTP1.Connected then Label1.Caption:='Baglandı' else begin  Label1.Caption:='Hata'; end;
end;

procedure TForm1.btnPutClick(Sender: TObject);
 var
   yol:string;
 begin
   yol:=ExtractFileDir(Application.ExeName)+'\clientGiden\';
   IdFTP1.Put(yol+'clientGiden.txt','serverGelen\clientGiden.txt',false);

end;

procedure TForm1.btnMakeDirClick(Sender: TObject);
begin
 IdFTP1.MakeDir('klasorEkleme');  //çalışdı
 ShowMessage('Ok');
end;

procedure TForm1.btnPut2Click(Sender: TObject);
 var
   filex:string;
   st:string;
begin
filex:='C:\Users\sadomazo\Desktop\FTP\22mart\client\clientGiden\clientGiden.txt';
 st:='clientGiden.txt';

 idFTP1.ChangeDir('123');

 if idFTP1.Connected then  Memo1.Lines.Add('sunucu: '+idFTP1.Host);
   if (pos(st,filex)>0) then
    begin
       idFTP1.Put(filex, '', false);
       Memo1.Lines.Add('Dosya başarıyla gönderildi');
     end else
           begin
              //Другое дейст
             // idFtp1.Disconnect;
           end;


  if Assigned(idFtp1) then
      begin
         idFtp1.Disconnect;
         idFtp1.Free;
      end;

end;

procedure TForm1.btnCreateDirClick(Sender: TObject);

 var
   dir: string;
 begin
   dir := ExtractFilePath(ParamStr(0)) + 'DklasorA\';
 if not(DirectoryExists(dir)) then // if folder not found, create it 
   begin
     CreateDir(dir);  //çalıştı
   end;

   ChDir(dir);
end;

procedure TForm1.btnDeleteClick(Sender: TObject);
begin
 IdFTP1.Delete('123\1.txt');
end;

procedure TForm1.btnChangeDirClick(Sender: TObject);
begin
 try
 form1.IdFTP1.ChangeDir('Kdeneme');
except
 on E: EInOutError do
 ShowMessage('Hata: ' +  E.ClassName +  '/' +  E.Message);
end;
end;


procedure TForm1.btnDosyaSilClick(Sender: TObject);
 var
   dir: string;
 begin
   dir := ExtractFilePath(ParamStr(0)) + 'Dklasor\';
   DeleteFile(dir + '\' + 'sil.txt');   //çalışdı

end;




function isFileExists(const fname: String): Boolean;
var
  StrLst: TStringList;
begin
  StrLst := TStringList.Create;
  try
   try
    Form1.idFTP1.ChangeDir('123');
    Form1.idFTP1.List(StrLst, fname);
    except
    end;
    result := StrLst.Count <> 0;
  finally
    StrLst.Free;
  end;
end;

function isFileExists2(const fname: String): Boolean;
var
i         : Integer;
LListItem : TIdFTPListItem;
LCount    : Integer;
LFileName : String;
begin
Form1.IdFTP1.ChangeDir('123');
Form1.IdFTP1.List;
LCount := Form1.IdFTP1.DirectoryListing.Count;
for i := 0 to LCount - 1 do begin
     LListItem := Form1.IdFTP1.DirectoryListing[i];
     LFileName := LListItem.FileName;
     if (LFileName = '.') or (LFileName = '..') then Continue;
     if LFileName=fname then result:=true;
   end;
end;


function fileexist2(fn:string):integer;
var lst:TStringList;
begin
 lst:=tstringlist.create;
 Form1.IdFTP1.ChangeDir('123');
 Form1.IdFTP1.List;
 Form1.IdFTP1.List(lst,fn,true);
 Result :=lst.Count;// (lst.Count > 0);      //result:=lst.count>0;// should be =1
 lst.free;
end;

function fileexist(fn:string):boolean;
var lst:TStringList;
begin
lst:=tstringlist.create;
Form1.IdFTP1.ChangeDir('123');
Form1.IdFTP1.List(lst,'',false);
Result:=(lst.indexOf(fn)>-1);
lst.free;
end;



procedure TForm1.btnFileexistsClick(Sender: TObject);
begin
showmessage(booltostr(fileexist('1.txt'),true));
//showmessage(booltostr(isFileExists('123\1.txt'),true));
//showmessage(booltostr(isFileExists2('1.txt'),true));
end;

procedure TForm1.btnGetClick(Sender: TObject);

 var
 yol:string;
begin
 try

     yol:=ExtractFileDir(Application.ExeName)+'\clientGelen\';
     IdFTP1.Get('ServerGiden\ServerGiden.txt',yol+'Serverdangeldi.txt',True);

   except
     // If there was an error the reason can be found here
     on E: EInOutError do
       ShowMessage('hata: ' +  E.ClassName +  '/' +  E.Message);

   end;
ShowMessage('Ok');
end;

procedure TForm1.Button2Click(Sender: TObject);
var
 filename:string;
begin
 filename:='test\fileexists.txt';
if (fileexists(filename) = false) then
  begin
       showmessage('Dosya Yok!');
       exit;
  end;
if (fileexists(filename) = true) then
  begin
       showmessage('Dosya Var!');
  end;

if (pos('test\fileexists.txt',filename)>0) then
  begin
       showmessage('Dosya Var!');
  end;

end;

procedure TForm1.Button3Click(Sender: TObject);
begin
Try


Except ON E:Exception do
memo1.lines.add(E.message);
End;
end;



procedure TForm1.Button4Click(Sender: TObject);
 var
   dir: string;
   searchResult: TSearchRec;
 begin
 dir := ExtractFilePath(ParamStr(0));// + 'serverGiden\';

   try // find all files in read_ftp folder and delete all
     begin
       FindFirst(dir + '\*.*', faAnyFile + faReadOnly, searchResult);
       ListBox1.Items.Add(searchResult.Name);
       while FindNext(searchResult) = 0 do
       begin
         ListBox1.Items.Add('-'+searchResult.Name);
       end;
       FindClose(searchResult);

     end;
   except
   end;

end;

procedure TForm1.btnListClick(Sender: TObject);
var
 i:integer;
begin
idFTP1.ChangeDir('123');
 if idFTP1.Connected then
     begin
     IdFTP1.List;
        for i:=2 to idFTP1.DirectoryListing.Count-1 do
          ListBox1.Items.Add(idFTP1.DirectoryListing.Items[i].FileName);
     end;
if Assigned(idFtp1) then
  begin
  idFtp1.Disconnect;
  idFtp1.Free;
  end;

end;


procedure TForm1.Button5Click(Sender: TObject);
begin

end;



procedure TForm1.Memo1Change(Sender: TObject);
begin

end;

end.

**sadikacar60** · 24-03-2020, Saat: 12:32

arkadaşlar konuyu kapattık ama bir sorun yaşıyorum dağınık olmasın diye tekrar burda yazdım
.
örnek uygulamada her seferinde prg aç kapat yaparak deneme yaptığım iiçin sorunu anlayamadım.
sorun şu;
1 kere bağlandıktan sonra birden fazla işlem yapamıyorum. mesela serverde yeni bir klasör oluşturdum diyelim bu kod çalışıyor
arkasında bir klasördeki dosyaları listelemek istediğimde hata veriyor .

her seferinde bağlantıyı koparıp tekrar açmak mı gerekiyor veya bir şeyler mi yapmak lazım anlayamadım.
zira kapatıp tekrar bağlanarak yapmak istediğimdede hata alıyorum.

burda hatam ne acaba
saygılarımla

**sadikacar60** · 24-03-2020, Saat: 15:31

arkadaşlar
idFtp1.Free;

satırından kaynaklanıyorumuş bu satırı iptal ettim düzeldi . üst üste bir çok olay yapıyor hata vermiyor.
bu free satırının görevi nedir muhtemelen programı kapatırken portu bağlantıyı tamamen kapatmak için olabilir

saygılarımla

**cinarbil**

(24-03-2020, Saat: 15:31)sadikacar60 Adlı Kullanıcıdan Alıntı: arkadaşlar
idFtp1.Free;

satırından kaynaklanıyorumuş bu satırı iptal ettim düzeldi . üst üste bir çok olay yapıyor hata vermiyor.
bu free satırının görevi nedir muhtemelen programı kapatırken portu bağlantıyı tamamen kapatmak için olabilir

saygılarımla

Delphi tarafında ustaların izniyle

  if Assigned(idFtp1) then   // eğer  idFtp1 (oluşturlmuşsa, varsa)
     begin
        idFtp1.Disconnect;  // bağlantıyı kapat
        idFtp1.Free;   // idFtp1 hafızada sil, bu iş için kaynakları serbest bırak 
     end;

**sadikacar60** · 25-03-2020, Saat: 11:33

arkadaşlar konuyu tekrar tekrar canlandırdığım için üzğünüm sorunlar uygulama esnasında çıktığı için inşallah son kez bir sorunumu daha paylaşacağım.

IdFTP1.ChangeDir('klasor1');

ChangeDir komutunu 1 olayda kullandığım sorun yapmadı sonra

IdFTP1.ChangeDir('klasor2');

başka bir olay için tekrar kullandım diyelim

ilk hangisini çalıştırısam çalışıyor ikincisini çalıştırmak istediğimde hata veriyor.
örnegin önce put komutu kullandım arkasından get komutu kullanmak istediğimde hata alıyorum hataya
ChangeDir komutu sebeb oluyor bunu sebebi nedir acaba?

ikinci olarak.
IdFTP1.List; komutunu kullanırken ChangeDir kullanmadan hangi klasördeki dosyaları listeleyeceğini belirtebiliyormuyuz
örneğin IdFTP1.List('Kalasor3'); //klasör3 içindeki dosyaları listele şeklinde mümkün mü.

saygılarımla

**cinarbil** · 25-03-2020, Saat: 12:37

(25-03-2020, Saat: 11:33)sadikacar60 Adlı Kullanıcıdan Alıntı: arkadaşlar konuyu tekrar tekrar canlandırdığım için üzğünüm sorunlar uygulama esnasında çıktığı için inşallah son kez bir sorunumu daha paylaşacağım.
IdFTP1.ChangeDir('klasor1');  
ChangeDir komutunu 1 olayda kullandığım sorun yapmadı sonra
IdFTP1.ChangeDir('klasor2');  
başka bir olay için tekrar kullandım diyelim

ilk hangisini çalıştırısam çalışıyor ikincisini çalıştırmak istediğimde hata veriyor.
örnegin önce put komutu kullandım arkasından get komutu kullanmak istediğimde hata alıyorum hataya
ChangeDir komutu sebeb oluyor bunu sebebi nedir acaba?

ikinci olarak.
IdFTP1.List; komutunu kullanırken ChangeDir kullanmadan hangi klasördeki dosyaları listeleyeceğini belirtebiliyormuyuz
örneğin IdFTP1.List('Kalasor3'); //klasör3 içindeki dosyaları listele şeklinde mümkün mü.

saygılarımla

daha önce @Halil Han BADEM arkadaşımız aşağıdaki mesajda güzel örneklemiş
https://www.delphican.com/showthread.php...&pid=13338

istediğiniz gibi list changedir örneklemiş ellerine sağlık

Ayrıca mesajın başındaki çözüldüğü kaldırırsanız başka arkadaşlar daha iyi bilgi verebilir

**sadikacar60** · 25-03-2020, Saat: 22:57

   if  IdFTP1.Connected=false then IdFTP1.Connect;
  idFTP1.ChangeDir('ServerGiden');
     yol:=ExtractFileDir(Application.ExeName)+'\clientGelen\';
  IdFTP1.Get('ServerGiden.txt',yol+'Serverdangeldi.txt',True);

    if  IdFTP1.Connected=false then IdFTP1.Connect;
   idFTP1.ChangeDir('serverGelen');
   yol:=ExtractFileDir(Application.ExeName)+'\clientGiden\';
   IdFTP1.Put(yol+'clientGiden.txt','clientdenGeldi.txt',false);

yukardaki put veye get komutunu sırayla çalıştıramıyorum put çalışıyor get çalışmıyor ilk tıkladığım çalışıyor ikinciye çalışmıyor.
cinarbil hocam verdiğiniz linkde sorunu anlatan bir kısım bulamadım

sonradan farkettim tek fark IdFTP1.Disconnect; kullanılmış bende kullandım sorun düzeldi. artık istediğim komutu istediğim kadar kullanabiliyorum
benim için sorun çözüldü gibi ama olması gereken bu mu her işlemden sonra bağlantıyı koparıp tekrar bağlanmak mı lazım onu bilmiyorum

saygılarımla

**Bay_Y** · 26-03-2020, Saat: 10:48

paylaşım ve katkı yapan tüm arkadaşlara teşekkürler.

Giriş Yap
Kullanıcı Adı:
Şifreniz:	Şifremi Unuttum?
	Beni Hatırla

Konu ile Alakalı Benzer Konular
Konular		Yazar	Yorumlar	Okunma	Son Yorum
	AdoQuery ile ilgili bir sorun. (Çözüldü)	Bay_Y	4	111	17-04-2024, Saat: 10:58 Son Yorum: Bay_Y
	Fastreport İçindekiler Sayfası Oluşturma [ÇÖZÜLDÜ]	bydelphi	1	237	18-03-2024, Saat: 12:11 Son Yorum: bydelphi
	Çok Satırlı Filtreleme [Çözüldü]	bünyamin68	12	1.352	14-02-2024, Saat: 22:42 Son Yorum: mustafaozpinar
	[ÇÖZÜLDÜ] macos işletim sistemine program yazmak	shooterman	5	513	02-02-2024, Saat: 09:54 Son Yorum: shooterman
	COZULDU veritabani prg yerine ne kullanabilirim.	sadikacar60	8	775	29-01-2024, Saat: 18:41 Son Yorum: sadikacar60