Konuyu Oyla:
  • Derecelendirme: 0/5 - 0 oy
  • 1
  • 2
  • 3
  • 4
  • 5
çözüldü-IdTrivialFTP1 ve IdTrivialFTPServer1 kompenantları hk.
#21
evet hocam gözden kaçırmışım çalışıyor çok teşekkür eder saygılar sunarım.
Ekmeğimi yazılımdan kazanmıyorum kendi halimde bir şeyler yapıyorum. 49 yaşında emekliyim.
iyne sokmadan yardımcı olacaksan başımın üstünde yerin var.

Cevapla
#22
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 Smile
   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. 
Ekmeğimi yazılımdan kazanmıyorum kendi halimde bir şeyler yapıyorum. 49 yaşında emekliyim.
iyne sokmadan yardımcı olacaksan başımın üstünde yerin var.

Cevapla
#23
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
Ekmeğimi yazılımdan kazanmıyorum kendi halimde bir şeyler yapıyorum. 49 yaşında emekliyim.
iyne sokmadan yardımcı olacaksan başımın üstünde yerin var.

Cevapla
#24
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
Ekmeğimi yazılımdan kazanmıyorum kendi halimde bir şeyler yapıyorum. 49 yaşında emekliyim.
iyne sokmadan yardımcı olacaksan başımın üstünde yerin var.

Cevapla
#25
(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;
"…De ki: "Hiç bilenlerle bilmeyenler bir olur mu? Şüphesiz, temiz akıl sahipleri öğüt alıp-düşünürler" (Zümer Suresi, 9)
Cevapla
#26
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
Ekmeğimi yazılımdan kazanmıyorum kendi halimde bir şeyler yapıyorum. 49 yaşında emekliyim.
iyne sokmadan yardımcı olacaksan başımın üstünde yerin var.

Cevapla
#27
(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
"…De ki: "Hiç bilenlerle bilmeyenler bir olur mu? Şüphesiz, temiz akıl sahipleri öğüt alıp-düşünürler" (Zümer Suresi, 9)
Cevapla
#28
   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
Ekmeğimi yazılımdan kazanmıyorum kendi halimde bir şeyler yapıyorum. 49 yaşında emekliyim.
iyne sokmadan yardımcı olacaksan başımın üstünde yerin var.

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


Konu ile Alakalı Benzer Konular
Konular Yazar Yorumlar Okunma Son Yorum
  çözüldü-screenshot yapmak hk. sadikacar60 8 406 27-03-2020, Saat: 21:11
Son Yorum: sadikacar60
  [ÇÖZÜLDÜ-SOLVED] StringGrid Satır Taşıma(Move Row) 3ddark 7 324 23-03-2020, Saat: 13:08
Son Yorum: 3ddark
  ÇÖZÜLDÜ-random un istediğimz sayıdan başlaması mümkün mü? sadikacar60 7 371 16-03-2020, Saat: 23:31
Son Yorum: sadikacar60
  ÇÖZÜLDÜ formu dialog alarak kullanmak mümkünmü? sadikacar60 7 309 12-03-2020, Saat: 00:25
Son Yorum: uparlayan
  [ÇÖZÜLDÜ] Proses Sıralaması hk. wiseman 10 420 10-03-2020, Saat: 09:54
Son Yorum: wiseman



Konuyu Okuyanlar: 1 Ziyaretçi