önerileerinizi bekliyorum.
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;
Button2: TButton;
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);
procedure Button2Click(Sender: TObject);
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.***.***.116';
if RadioGroup1.ItemIndex=1 then IdTrivialFTP1.Host:='85.***.***.221';
if RadioGroup1.ItemIndex=2 then IdTrivialFTP1.Host:='195.***.106.34';
end;
procedure TForm1.Button1Click(Sender: TObject);
Var
ST : TMemoryStream;
I : Integer;
S : String;
begin
{ Create stream }
ST := TMemoryStream.Create;
{ Initialize data }
S := 'This is a test file. It whould appear in the '+
'TFTP Server''s upload directory.'+#13#10;
{ Store in stream }
ST.Write( S[1], Length(S) );
ST.Position := 0;
{ Send Stream to TFTP Server }
IdTrivialFTP1.Put(ST,'mus.dbf');
{ Free Stream }
If Assigned(ST) then FreeAndNil(ST);
{ Show a dialog }
ShowMessage('Done!');
end;
procedure TForm1.IdTrivialFTPServer1ReadFile(Sender: TObject;
var FileName: String; const PeerInfo: TPeerInfo;
var GrantAccess: Boolean; var AStream: TStream;
var FreeStreamOnComplete: Boolean);
Var
FS : TFileStream;
begin
FreeStreamOnComplete := True;
Try
{ Convert UNIX style filenames to WINDOWS style }
While Pos('/',Filename)<>0 do Filename[Pos('/',Filename)] := '\';
{ Assure that the filename DOES NOT CONTAIN any path information }
Filename := ExtractFileName( Filename );
{ Check if file exists }
If FileExists( Filename ) then
Begin
{ Open file in READ ONLY mode }
FS := TFileStream.Create( Filename,
fmOpenRead OR fmShareDenyWrite );
{ Assign stream to variable }
AStream := FS;
{ Set parameters }
GrantAccess := True;
End Else
Begin
GrantAccess := False;
End;
Except
{ On errors, deny access }
GrantAccess := False;
If Assigned(FS) then FreeAndNil( FS );
End;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
IdTrivialFTPServer1.ThreadedEvent := True;
IdTrivialFTPServer1.Active := True;
{ Set the path to where the files will be stored/retreived }
//TFTPPath := IncludeTrailingPathDelimiter('C:\Temp');
Memo1.Clear;
end;
procedure TForm1.IdTrivialFTPServer1TransferComplete(Sender: TObject;
const Success: Boolean; const PeerInfo: TPeerInfo; AStream: TStream;
const WriteOperation: Boolean);
begin
// Success = TRUE if the read/write operation was successfull
// WriteOperation = TRUE if the client SENT a file to the server
Try
{ Close the FileStream }
If Assigned(AStream) then FreeAndNil(AStream);
Except
End;
end;
// Example of how to DOWNLOAD a file from the server
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
FS : TFileStream;
begin
Try
{ Convert UNIX style filenames to WINDOWS style }
While Pos('/',Filename)<>0 do Filename[Pos('/',Filename)] := '\';
{ Assure that the filename DOES NOT CONTAIN any path information }
Filename := ExtractFileName( Filename );
{ Open file in WRITE ONLY mode }
FS := TFileStream.Create( Filename,
fmCreate OR fmShareExclusive );
{ Copy all the data }
AStream := FS;
{ Set parameters }
FreeStreamOnComplete := True;
GrantAccess := True;
Except
{ On errors, deny access }
GrantAccess := False;
If Assigned(FS) then FreeAndNil( FS );
End;
end;
procedure TForm1.Button2Click(Sender: TObject);
Var
ST : TMemoryStream;
begin
ST := TMemoryStream.Create;
IdTrivialFTP1.Get('mus.dbf',ST);
If Assigned(ST) then
begin
ShowMessage('Filesize='+IntToStr(ST.Size));
FreeAndNil(ST);
end;
end;
end.