kod asagıdaki sekilde.
tavsiyeniz nedir?
Kod: Tümünü seç
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IdUDPServer, IdTrivialFTPServer, IdBaseComponent, IdComponent,
IdUDPBase, IdUDPClient, IdTrivialFTP, StdCtrls, ExtCtrls, ComCtrls,
QuickRpt;
type
TForm1 = class(TForm)
IdTrivialFTP1: TIdTrivialFTP;
IdTrivialFTPServer1: TIdTrivialFTPServer;
Button1: TButton;
RadioGroup1: TRadioGroup;
Memo1: TMemo;
Label1: TLabel;
ProgressBar1: TProgressBar;
procedure RadioGroup1Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure IdTrivialFTPServer1ReadFile(Sender: TObject;
var FileName: String; const PeerInfo: TPeerInfo;
var GrantAccess: Boolean; var AStream: TStream;
var FreeStreamOnComplete: Boolean);
procedure FormCreate(Sender: TObject);
procedure IdTrivialFTPServer1TransferComplete(Sender: TObject;
const Success: Boolean; const PeerInfo: TPeerInfo; AStream: TStream;
const WriteOperation: Boolean);
procedure IdTrivialFTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCountMax: Integer);
procedure IdTrivialFTP1WorkEnd(Sender: TObject; AWorkMode: TWorkMode);
procedure IdTrivialFTP1Work(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCount: Integer);
procedure IdTrivialFTPServer1WriteFile(Sender: TObject;
var FileName: String; const PeerInfo: TPeerInfo;
var GrantAccess: Boolean; var AStream: TStream;
var FreeStreamOnComplete: Boolean);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
var
teststream : tmemorystream;
procedure TForm1.RadioGroup1Click(Sender: TObject);
begin
if RadioGroup1.ItemIndex=0 then IdTrivialFTP1.Host:='62.xxx.xxx.116';
if RadioGroup1.ItemIndex=1 then IdTrivialFTP1.Host:='85.xxx.xxx.221';
if RadioGroup1.ItemIndex=2 then IdTrivialFTP1.Host:='195.xxx.xxx.34';
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
IdTrivialFTP1.Active:=True;
IdTrivialFTP1.Put('mus.dbf','mus.dbf');
IdTrivialFTP1.Active:=False;
IdTrivialFTP1.Free;
end;
procedure TForm1.IdTrivialFTPServer1ReadFile(Sender: TObject;
var FileName: String; const PeerInfo: TPeerInfo;
var GrantAccess: Boolean; var AStream: TStream;
var FreeStreamOnComplete: Boolean);
begin
grantaccess := true;
freestreamoncomplete := false;
astream := teststream;
astream.Position := 0;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Memo1.Clear;
end;
procedure TForm1.IdTrivialFTPServer1TransferComplete(Sender: TObject;
const Success: Boolean; const PeerInfo: TPeerInfo; AStream: TStream;
const WriteOperation: Boolean);
begin
if assigned(astream) then astream.Free;
end;
procedure TForm1.IdTrivialFTP1WorkBegin(Sender: TObject;
AWorkMode: TWorkMode; const AWorkCountMax: Integer);
begin
ProgressBar1.Visible:=True;
ProgressBar1.Position:=0;
ProgressBar1.Max:=AWorkCountMax;
if AWorkCountMax>0 then Label1.Caption:=IntToStr(AWorkCountMax);
Application.ProcessMessages;
end;
procedure TForm1.IdTrivialFTP1WorkEnd(Sender: TObject;
AWorkMode: TWorkMode);
begin
Label1.Caption:='işlem tamamlandı';
ProgressBar1.Visible:=False;
Application.ProcessMessages;
end;
procedure TForm1.IdTrivialFTP1Work(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCount: Integer);
begin
if ProgressBar1.Max>0 then begin
Label1.Caption:='transfer durumu'+IntToStr(AWorkCount)+' / '+IntToStr(ProgressBar1.Max)+'byte';
ProgressBar1.Position:=AWorkCount;
end else
Label1.Caption:=IntToStr(AWorkCount)+'byte';
Application.ProcessMessages;
end;
procedure TForm1.IdTrivialFTPServer1WriteFile(Sender: TObject;
var FileName: String; const PeerInfo: TPeerInfo;
var GrantAccess: Boolean; var AStream: TStream;
var FreeStreamOnComplete: Boolean);
var
outps: tmemorystream;
begin
showmessage(filename);
grantaccess := true;
freestreamoncomplete := true;
outps := tmemorystream.Create;
astream := outps;
{freestreamoncomplete := false;
//
astream.Position := 0;
outps := tmemorystream.create;
outps.CopyFrom(astream, astream.size);
outps.Position := 0;
outps.SaveToFile('c:\'+filename);
outps.Free; }
end;
end.