client:
{TT8(scott huang ,XiaMen,China) 2003.07.11 INDY TcpServer,TcpClient 上传文件实例
仅供参考 如果造成你的什么损失 我一概不管。
如果你有更好的主意,请把修改好(或则全新)的源程序发到 tt8tt8@21cn.com 供我参考
}
unit client;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient, FileCtrl,inifiles;
type
TForm2 = class(TForm)
TCPClient: TIdTCPClient;
ProgressBar1: TProgressBar;
CurNum: TLabel;
TolNum: TLabel;
BeginUpdate: TButton;
EdPort: TEdit;
LogMemo: TMemo;
EdHost: TEdit;
ListBox1: TListBox;
SelectFIle: TButton;
OpenDialog1: TOpenDialog;
Label1: TLabel;
procedure TCPClientWork(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCount: Integer);
procedure TCPClientWorkEnd(Sender: TObject; AWorkMode: TWorkMode);
procedure BeginUpdateClick(Sender: TObject);
procedure SelectFIleClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form2: TForm2;
myinifile:Tinifile;
implementation
{$R *.dfm}
procedure TForm2.TCPClientWork(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCount: Integer);
begin
if AWorkMode = wmWrite then
begin
CurNum.Caption := IntToStr(AWorkCount);
ProgressBar1.Position := AWorkCount;
Update;
end;
end;
procedure TForm2.TCPClientWorkEnd(Sender: TObject; AWorkMode: TWorkMode);
begin
TolNum.Caption := InttoStr(StrToInt(TolNum.Caption)+StrToInt(CurNum.Caption));
update;
end;
procedure TForm2.BeginUpdateClick(Sender: TObject);
var
FileStream: TFileStream;
FIleSize: Int64;
i: Integer;
flag:boolean;
begin
if listbox1.Count<=0 then
begin
showmessage('Please select files first.');
exit;
end;
with TCPClient do
begin
Port := StrToInt(EdPort.Text);
Host := EdHost.Text;
if not Connected then
begin
try
Connect;
except
LogMemo.Lines.Add('上传服务没有开启!');
exit;
end;
end;
for i := 0 to ListBox1.Items.Count-1 do
begin
WriteLn(listbox1.items);
flag:=true;
try
FileStream := TFileStream.Create(listbox1.items,fmOpenRead);
FileSize := FileStream.Size;
ProgressBar1.Max:=FileSize;
ProgressBar1.Position:=0;
WriteStream(FileStream,True,True,FileSize);
except
Flag:=false;
end;
FileStream.Free;
if flag then
LogMemo.Lines.add(DateTimeToStr(Now)+'上传'+listbox1.items+' Success')
else
LogMemo.Lines.add(DateTimeToStr(Now)+'上传'+listbox1.items+' error.');
end;
// LogMemo.Lines.add(DateTimeToStr(Now)+'上传正常完成!');
end;
end;
procedure TForm2.SelectFIleClick(Sender: TObject);
var i:integer;
begin
// showmessage(opendialog1.InitialDir);
if opendialog1.execute=true then
with opendialog1 do
begin
if files.count>0 then //选择了文件
begin
listbox1.clear;
for i:=0 to files.count-1 do
if fileexists(Files) then
listbox1.items.add(Files);
end;
end;
end;
procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
begin
TCPClient.disconnect;
myinifile.writestring('FileTransClient','Host',edHost.Text);
myinifile.writestring('FileTransClient','Port',edPort.Text);
myinifile.Destroy;
end;
procedure TForm2.FormCreate(Sender: TObject);
var FileName:string;
begin
Filename:=ExtractFilePath(Paramstr(0))+'client.ini';
myinifile:=Tinifile.Create(filename);
edHost.Text:=myinifile.Readstring('FileTransClient','Host','127.0.0.1');
edPort.Text:=myinifile.Readstring('FileTransClient','Port','6123');
opendialog1.InitialDir:=myinifile.Readstring('FileTransClient','InitialDir','');
end;
end.
server:
{TT8(scott huang ,XiaMen,China) 2003.07.11 INDY TcpServer,TcpClient 上传文件实例
仅供参考 如果造成你的什么损失 我一概不管。
如果你有更好的主意,请把修改好(或则全新)的源程序发到 tt8tt8@21cn.com 供我参考
}
unit server;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPServer;
type
TForm1 = class(TForm)
TCPServer: TIdTCPServer;
LogMemo: TMemo;
EdPort: TEdit;
StartServer: TButton;
StopServer: TButton;
Label1: TLabel;
procedure StartServerClick(Sender: TObject);
procedure StopServerClick(Sender: TObject);
procedure TCPServerExecute(AThread: TIdPeerThread);
procedure TCPServerConnect(AThread: TIdPeerThread);
procedure TCPServerDisconnect(AThread: TIdPeerThread);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.StartServerClick(Sender: TObject);
begin
with TCPServer do
begin
Active := False;
DefaultPort := StrToInt(EdPort.Text);
Active := True;
LogMemo.Lines.Add(DateTimeToStr(Now)+' 服务已经启动!(Port: '+EdPort.Text+')');
end;
end;
procedure TForm1.StopServerClick(Sender: TObject);
begin
with TCPServer do
begin
Active := False;
LogMemo.Lines.Add(DateTimeToStr(Now)+' 服务已经停止!');
end;
end;
procedure TForm1.TCPServerExecute(AThread: TIdPeerThread);
var
FileStream: TFileStream;
FileStr: String;
flag:boolean;
begin
with AThread.Connection do
begin
while Connected do
begin
FileStr := 'upload/'+extractfilename(ReadLn);
LogMemo.Lines.Add(datetimetostr(now)+' Receiveing file:'+FileStr);
flag:=true;
try
FileStream := TFileStream.Create(FileStr,fmCreate);
ReadStream(FileStream,-1,False);
except
flag:=false
end;
fileStream.Free;
if flag then
LogMemo.Lines.Add(datetimetostr(now)+' ok.')
else LogMemo.Lines.Add(datetimetostr(now)+' fail.');
end;
end;
end;
procedure TForm1.TCPServerConnect(AThread: TIdPeerThread);
begin
LogMemo.Lines.Add('connected:'+Athread.Connection.Socket.Binding.PeerIP);
end;
procedure TForm1.TCPServerDisconnect(AThread: TIdPeerThread);
begin
LogMemo.Lines.Add('Disconnected:'+Athread.Connection.Socket.Binding.PeerIP);end;
procedure TForm1.FormCreate(Sender: TObject);
begin
//TransFiles Client 2003.07.11 Provided by TT8(scott huang,Xiamen,China)
end;
end.