delphi 传输文件例子的核心代码


你可以用,DELPHI7的INDY这组控件。
采用的是TCP协议,支持多线程,而且也可以监控流量。
如果你用得是DELPHI6,那么可以去http://www.nevrona.com/indy/下载一个。
下面是我写的部分代码:
SERVER
procedure TFrmUpdate.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 TFrmUpdate.StopServerClick(Sender: TObject);
begin
 with TCPServer do
 begin
  Active := False;
  LogMemo.Lines.Add(DateTimeToStr(Now)+' 服务已经停止!');
 end;
end;
procedure TFrmUpdate.TCPServerExecute(AThread: TIdPeerThread);
var
 FileStream: TFileStream;
 FileSize: Int64;
 FileStr: String;
begin
 with AThread.Connection do
 begin
  while Connected do
  begin
   FileStr := ReadLn;
   if FileExists(ExtractFilePath(Application.ExeName)+FileStr) then
    FileStream := TFileStream.Create(ExtractFilePath(Application.ExeName)+FileStr,fmOpenRead)
   else
   begin
    LogMemo.Lines.Add(DateTimeToStr(Now)+' '+FileStr+' 没有找到!');
    FileStream := TFileStream.Create(ExtractFilePath(Application.ExeName)+'Error.dll',fmOpenRead);
   end;
   try
    FileSize := FileStream.Size;
    WriteStream(FileStream,True,True,FileSize);
   finally
    fileStream.Free;
   end;
  end;
 end;
end;
procedure TFrmUpdate.TCPServerConnect(AThread: TIdPeerThread);
begin
 LogMemo.Lines.Add(InttoStr(AThread.ThreadID));
end;
CLIENT
procedure TFrmUpdate.TCPClientWork(Sender: TObject; AWorkMode: TWorkMode;
 const AWorkCount: Integer);
begin
 if AWorkMode = wmRead then
 begin
  CurNum.Caption := IntToStr(AWorkCount);
  ProgressBar1.Position := AWorkCount;
  Update;
 end;
end;
procedure TFrmUpdate.BeginUpdateClick(Sender: TObject);
var
 FileStream: TFileStream;
 i: Integer;
begin
 if FuncObj.IniInfo['Update','EnUpdate']<>'True' then
 begin
  FuncObj.Prompt('升级功能被禁止!');
  Exit;
 end;
 with TCPClient do
 begin
  Port := StrToInt(FuncObj.IniInfo['Update','Port']);
  if FuncObj.IniInfo['Update','Host']='' then
   Host := FuncObj.ServerIP
  else
   Host := FuncObj.IniInfo['Update','Host'];
  if not Connected then
  begin
   try
    Connect;
   except
    FuncObj.Prompt('升级服务没有开启!');
   end;
  end;
  for i := 0 to FileListBox.Items.Count-1 do
  begin
   if FileListBox.Checked[i] then
   begin
    FName.Caption := '';
    FName.Update;
    FileList.First;
    while not FileList.Eof do
    begin
     if VartoStr(FileList.Fieldvalues['RightName'])=FileListBox.Items.Strings[i] then
     begin
      FName.Caption := FileList.Fieldvalues['ModuleName'];
      FName.Update;
      Break;
     end;
     FileList.Next;
    end;
    WriteLn(FileList.Fieldvalues['ModuleName']+'.dll');
    try
     FileStream := TFileStream.Create(ExtractFilePath(Application.ExeName)+FileList.Fieldvalues['ModuleName']+'.dll',fmCreate);
     ReadStream(FileStream,-1,False);
    finally
     FileStream.Free;
    end;
   end;
  end;
  FuncObj.Prompt('升级正常完成!');
  Close;
 end;
end;
procedure TFrmUpdate.TCPClientWorkEnd(Sender: TObject;
 AWorkMode: TWorkMode);
begin
 TolNum.Caption := InttoStr(StrToInt(TolNum.Caption)+StrToInt(CurNum.Caption));
end;
由于是从程序出截取的部分代码,所以可能有不相关的垃圾。[:D]
希望对你有用。

联系电话:
020-00000000
联系电话:
020-00000000
联系电话:
020-12345678