Delphi LAN 지점 간 파일 전송(IdTcpClient 컨트롤)
38911 단어 Delphi
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, ExtCtrls, ComCtrls, ScktComp, IdTCPServer,
IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient;
type
TForm1 = class(TForm)
Panel1: TPanel;
Panel2: TPanel;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
SpeedButton3: TSpeedButton;
LBFiles: TLabel;
SpeedButton4: TSpeedButton;
SpeedButton5: TSpeedButton;
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
PB2: TProgressBar;
PB1: TProgressBar;
ListBox1: TListBox;
Label2: TLabel;
IdTCPClient1: TIdTCPClient;
IdTCPServer1: TIdTCPServer;
LBSend: TLabel;
Edit1: TEdit;
Label1: TLabel;
IdTCPClient2: TIdTCPClient;
IdTCPServer2: TIdTCPServer;
procedure SpeedButton1Click(Sender: TObject);
procedure ListBox1DblClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure SpeedButton4Click(Sender: TObject);
procedure IdTCPServer1Execute(AThread: TIdPeerThread);
procedure SpeedButton5Click(Sender: TObject);
procedure SpeedButton3Click(Sender: TObject);
procedure IdTCPServer2Connect(AThread: TIdPeerThread);
procedure IdTCPServer2Execute(AThread: TIdPeerThread);
private
{ Private declarations }
public
Function Act_DownFiles(CurFilePath,SerFilePath,CurFileName,SerFileName:String):Boolean;
end;
var
Form1: TForm1;
UserName:String;
RecivList:TStrings;
SendIP:String;
DownFlag:Boolean;
implementation
{$R *.dfm}
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
if OpenDialog1.Execute then
begin
if ListBox1.Items.IndexOf(OpenDialog1.FileName) = -1 then
begin
ListBox1.Items.Add(OpenDialog1.FileName);
end;
end;
end;
procedure TForm1.ListBox1DblClick(Sender: TObject);
begin
if ListBox1.ItemIndex >=0 then
ListBox1.Items.Delete(ListBox1.ItemIndex);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
self.Height:=267;
IdTCPServer2.Active:=True;
IdTCPServer1.Active:=True;
UserName:='admin';
RecivList:=TStringList.Create;
DownFlag:=True;
end;
procedure TForm1.SpeedButton2Click(Sender: TObject);
var
TemFiles:String;
begin
if ListBox1.Count > 0 then
begin
SpeedButton2.Enabled:=False;
TemFiles:=ListBox1.Items.CommaText;
IdTCPClient2.Host :=Trim(Edit1.Text);//
if IdTCPClient2.Connected then
IdTCPClient2.Disconnect;
Try
IdTCPClient2.Connect;
except
MessageBox(Handle,' ',' ',MB_OK);
Exit;
end;
with IdTCPClient2 do
begin
while Connected do
begin
try
WriteLn('SendFiles#'+ListBox1.Items.CommaText+'%'+UserName); //
finally
Disconnect;//
end;
end;
end;
end
else
begin
MessageBox(Handle,' ',' ',MB_OK);
end;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
RecivList.Free;
end;
procedure TForm1.SpeedButton4Click(Sender: TObject);
var
CurFilePath,SerFilePath:String;
FileName,TemStr:String;
i,TemInt:integer;
begin
SpeedButton4.Enabled:=False;
DownFlag:=True;
TemStr:='';
TemInt:=0;
if SaveDialog1.Execute then
begin
CurFilePath:=ExtractFilePath(SaveDialog1.FileName);
for i:=0 to RecivList.Count - 1 do
begin
SerFilePath:=ExtractFilePath(RecivList.Strings[i]);
FileName:=ExtractFileName(RecivList.Strings[i]);
if not Act_DownFiles(CurFilePath,SerFilePath,FileName,FileName) then
begin
TemInt:=TemInt+1;
TemStr:=TemStr+ FileName;
end;
end;
if TemInt > 0 then
begin
MessageBox(Handle,PChar(TemStr+' '),' ',MB_OK);
end
else
begin
MessageBox(Handle,' ',' ',MB_OK);
end;
IdTCPClient1.Host :=SendIP;
if IdTCPClient1.Connected then
IdTCPClient1.Disconnect;
Try
IdTCPClient1.Connect;
except
MessageBox(Handle,' ',' ',MB_OK);
Exit;
end;
with IdTCPClient1 do
begin
while Connected do
begin
try
WriteLn('OK'); //
finally
Disconnect;//
end;
end;
end;
Close;
end;
end;
Function TForm1.Act_DownFiles(CurFilePath,SerFilePath,CurFileName,SerFileName:String):Boolean;
var
TemFileName:String;
rbyte:array[0..4096] of byte;
sFile:TFileStream;
iFileSize:integer;
begin
PB1.Position:=0;
IdTCPClient1.Host :=SendIP;//
if IdTCPClient1.Connected then
IdTCPClient1.Disconnect;
Try
IdTCPClient1.Connect;
except
MessageBox(Handle,' ',' ',MB_OK);
Result:=False;
Exit;
end;
with IdTCPClient1 do
begin
while Connected do
begin
try
TemFileName:=SerFilePath+SerFileName;
WriteLn(TemFileName); //
if ReadLn<>' ' then
begin
iFileSize:=IdTCPClient1.ReadInteger;
PB1.Max := iFileSize div 100 ;
sFile:=TFileStream.Create(CurFilePath+CurFileName,fmCreate);
While iFileSize>4096 do
begin
if DownFlag then
begin
IdTCPClient1.ReadBuffer(rbyte,4096);// .ReadBuffer(rbyte,iLen);
sFile.Write(rByte,4096);
inc(iFileSize,-4096);
PB1.Position:= PB1.Position +(4096 div 100) ;
Application.ProcessMessages;
end
else
begin
Result:=False;
Exit;
end;
end;
IdTCPClient1.ReadBuffer(rbyte,iFileSize);// .ReadBuffer(rbyte,iLen);
sFile.Write(rByte,iFileSize);
sFile.Free;
PB1.Position:=PB1.Max;
end;
finally
Disconnect;//
end;
end;
end;
Result:=True;
end;
procedure TForm1.IdTCPServer1Execute(AThread: TIdPeerThread);
var
RecevFileName:string;
iFileHandle:integer;
iFileLen,cnt:integer;
buf:array[0..4096] of byte;
begin
if not AThread.Terminated and AThread.Connection.Connected then //
begin
with AThread.Connection do
begin
Try
RecevFileName:=AThread.Connection.ReadLn;
if RecevFileName='OK' then
begin
PB2.Position:=0;
LBSend.Caption:='All Files Send OK';
end;
if RecevFileName='RefusedAll' then
begin
LBSend.Caption:='All Files are Refused';
PB2.Position:=0;
end;
if (RecevFileName<>'OK') and (RecevFileName<>'RefusedAll') then
begin
if FileExists(RecevFileName) then
begin
PB2.Position:=0;
WriteLn(RecevFileName);
LBSend.Caption:='Send: '+RecevFileName;
iFileHandle:=FileOpen(RecevFileName,fmOpenRead); //
iFileLen:=FileSeek(iFileHandle,0,2);
FileSeek(iFileHandle,0,0);
AThread.Connection.WriteInteger(iFileLen,True);////hjh 20071009
PB2.Max := iFileLen div 100 ;
while iFileLen >0 do
begin
cnt:=FileRead(iFileHandle,buf,4096);
AThread.Connection.WriteBuffer(buf,cnt,True);/////hjh20071009
iFileLen:=iFileLen-cnt;
PB2.Position:=PB2.Position +(4096 div 100) ;
Application.ProcessMessages;
end;
FileClose(iFileHandle);
end
else
begin
WriteLn(' ');
end;
end;
Finally
Disconnect;//
end;
end;
end;
end;
procedure TForm1.SpeedButton5Click(Sender: TObject);
var
i:integer;
begin
DownFlag:=False;
IdTCPClient1.Host :=SendIP;//
if IdTCPClient1.Connected then
IdTCPClient1.Disconnect;
Try
IdTCPClient1.Connect;
except
MessageBox(Handle,' ',' ',MB_OK);
Exit;
end;
with IdTCPClient1 do
begin
while Connected do
begin
try
WriteLn('RefusedAll'); //
finally
Disconnect;//
end;
end;
end;
IdTCpClient1.Disconnect;
//Application.Terminate;
end;
procedure TForm1.SpeedButton3Click(Sender: TObject);
var
TemStr:String;
begin
if Trim(LBSend.Caption)='' then
begin
Close;
end;
if Trim(LBSend.Caption)='All Files Send OK' then
begin
Close;
end
else
begin
PB2.Position:=0;
IdTCPClient2.Host :=Trim(Edit1.Text);//
if IdTCPClient2.Connected then
IdTCPClient2.Disconnect;
Try
IdTCPClient2.Connect;
except
MessageBox(Handle,' ',' ',MB_OK);
Exit;
end;
with IdTCPClient2 do
begin
while Connected do
begin
try
WriteLn('RefuseSend'); //
finally
Disconnect;//
end;
end;
end;
end;
end;
procedure TForm1.IdTCPServer2Connect(AThread: TIdPeerThread);
begin
SendIP:=AThread.Connection.Socket.Binding.PeerIP;
end;
procedure TForm1.IdTCPServer2Execute(AThread: TIdPeerThread);
var
RecivStr,FileStr:String;
TemList:TStrings;
TemUser:String;
i:integer;
begin
if not AThread.Terminated and AThread.Connection.Connected then //
begin
with AThread.Connection do
begin
Try
FileStr:='';
RecivStr:=ReadLn;
if RecivStr <>'RefuseSend' then
begin
if Pos('SendFiles',RecivStr) > 0 then
begin
Self.Height:=130;
Panel1.Visible:=False;
RecivList.Clear;
RecivList.CommaText:=Copy(RecivStr,Pos('#',RecivStr)+1,Pos('%',RecivStr)-Pos('#',RecivStr)-1);
TemUser:=Copy(RecivStr,Pos('%',RecivStr)+1,Length(RecivStr)-Pos('%',RecivStr));
for i:=0 to RecivList.Count -1 do
begin
FileStr:=FileStr+ExtractFileName(RecivList.Strings[i])+',';
end;
LBFiles.Caption:=TemUser+' :'+FileStr+' ';
end;
end;
if RecivStr='RefuseSend' then
begin
LBFiles.Caption:=' ';
PB1.Position:=0;
DownFlag:=False;
end;
Finally
Disconnect;
end;
end;
end;
end;
end.
이 내용에 흥미가 있습니까?
현재 기사가 여러분의 문제를 해결하지 못하는 경우 AI 엔진은 머신러닝 분석(스마트 모델이 방금 만들어져 부정확한 경우가 있을 수 있음)을 통해 가장 유사한 기사를 추천합니다:
[Delphi] TStringBuilder그리고 꼭 사용해야만 할까? 그림처럼 Heap 영역에 "Hello" 공간을 생성하고 포인팅을 한다. "Hello World" 공간을 새로 생성한 후 포인팅을 하게 된다. 결국 "Hello" 라는 String 객체가 ...
텍스트를 자유롭게 공유하거나 복사할 수 있습니다.하지만 이 문서의 URL은 참조 URL로 남겨 두십시오.
CC BY-SA 2.5, CC BY-SA 3.0 및 CC BY-SA 4.0에 따라 라이센스가 부여됩니다.