Tuesday, 24 April 2018

socket 传输文件编程 传送大文件的算法

http://www.greensoftcode.net/techntxt/201141310049498110245

我采用的开发语言是delphi 当然采用其它开发语言大同小异。
在写代码之前先说下网络传送协议:常用的网络文件传输协议为:TCP 和UDP,两者的区别是TCP是面向连接的 UDP是非面向连接的。TCP所谓的面向连接的及三次握手协议,报文头加入验证字段等很复杂
UDP相对TCP报头帧相对简单无验证帧。

一.udp 传送文件的特点:
 1.速度快
 2.传送质量差可能丢包。
 3.1m小文件最佳
二、tcp 传送文件的特点:
  1.传送文件速度相对UDP较慢。
  2.传送质量较高丢包情况较少
  3.大文件传送佳。
三、udp传送代码:
采用delphi IdUDPClient、IDUDPSERVER的的控件
//发送端
function udpsenchangefile(filename:string ;ip:string;port:integer; bar:TProgressBar;mainfrm:TForm;iconarr:array of TIcon;label1:TLabel;label2:TLabel):boolean; //发送文件
var
receivedString:string;
stream:TFileStream;
posi,len:integer;
p:array[0..1023]  of byte;
sendresult:boolean;  //发送结果
sendedsize :integer;   //已发送字节数
udpclient:TIdUDPClient ;
begin
sendedsize:=0;
sendresult:=false;
udpclient:= TIdUDPClient.Create(Application);
udpclient.Host:=ip;
udpclient.Port:=port;
if  not udpclient.Active then udpclient.Active:=true;
posi:=0;
stream:=nil;
try
stream:=tfileStream.Create(filename,fmOpenRead);
if stream.Size>0 then
udpclient.Send('token'+'|'+filename+'|'+IntToStr(stream.Size));
receivedString:=udpclient.ReceiveString();
if uppercase(receivedString)=upperCase('agree-accept')then
begin
udpclient.Active:=false;
udpclient.Free ;
while posi<stream.Size do
begin
udpclient:= TIdUDPClient.Create(Application); //每发送一个文件建立一个对象 因为 我用一个控件时发送大于1M文件就程序就死掉啦!
udpclient.Host:=ip;
udpclient.Port:=port;
udpclient.ReceiveTimeout:=-2;
udpclient.BufferSize :=1024000;
udpclient.BroadcastEnabled:=false;
if  not udpclient.Active then udpclient.Active:=true;
len:= sendbytesize;                 //只能发  sendbytesize
if stream.Size< len then          //如果长度不到 sendbytesize
len:=stream.Size;
stream.Read(p,len);
udpclient.SendBuffer(p,len);
sendedsize:=sendedsize+1;
inc(posi,len);
label1.Caption:=inttostr(stream.Size);
bar.Position:=round(posi/stream.size*100);
//softtitle:=softtitle+inttostr(sendedsize)+'字节';
receivedString:=udpclient.ReceiveString();
//if ( sendedsize>0 )and (sendedsize mod 1000 =0) then Delay(5000);
label2.Caption:=inttostr( sendedsize);
if upperCase(ReceivedString)<>upperCase('receivedok') then    break;
application.ProcessMessages;
 changeico(mainfrm,softtitle, iconarr) ;
udpclient.Active:=false;
udpclient.Free ;
end;
udpclient.Send('tokenfilal');
if udpclient.ReceiveString()='receivefilal' then
sendresult:=true;
end
else
sendresult:=false;
finally
stream.Free;
end;
Result:=sendresult;
end;
接受端:
procedure Tmainfrm.udpserverUDPRead(Sender: TObject; AData: TStream;
  ABinding: TIdSocketHandle);
var
str ,receiveval:string;
temp:TStringList;
begin
aData.Seek(0,0);
setLength(receiveval,aData.size);
aData.Read(receiveval[1],aData.Size);
temp:= SplitString(receiveval,'|');
case protocol.IndexOf(temp[0])  of
 0: begin
    receiveFileName:=temp[1];
    receiveFileSize:=strtoint(temp[2]);
    filename:=createreceivedir(receiveFileName,receivedir);
     if not fileExists(filename) then
    stream:=TFileStream.Create(FileName,sysutils.fmOpenReadWrite or fmCreate)
    else
    stream:=TFileStream.Create(FileName,fmopenReadWrite);
    str:='agree-accept';
    abinding.SendTo(aBinding.PeerIP ,aBindIng.PeerPort  ,str[1],length(str));
    end   ;
  1:
   if stream<>nil then
    begin
    successfilesynchcount:=successfilesynchcount+1;
    stream.Free;
    stream:=nil;
    str:='receivefilal';
    aBinding.SendTo(aBinding.PeerIP,aBinding.PeerPort,str[1],length(str));
    filename:='';
    receiveFileName:='';
    receiveFileSize:=0;
    receivsize:=0;
    softtitle:='目前成功接受'+inttostr(successfilesynchcount)+'个文件!';
    end;
 else
   if stream<>nil then
   begin
   receivsize:=receivsize+1;
   softtitle:='正在接受'+ filename  ;
   stream.Seek(0,2);
   aData.Seek(0,0);
   stream.CopyFrom(aData,aData.Size);
   label1.Caption:=inttostr(  receivsize)   ;
   Bar.Position:=round(stream.size/receiveFileSize*100);
   str:='receivedok';
   abinding.SendTo(aBinding.PeerIP,aBinding.PeerPort,str[1],length(str));
   label2.Caption:=inttostr(  receivsize)   ;
   application.ProcessMessages;
   changeico(mainfrm,softtitle,   notifyicon) ;
   end;
end;
end;
通过这个例子udp 发送大文件时我发现确实存在不可靠事件,及文件可能没发送完!
要想准确发送成功!可能还要改进算法
tcp 发送例子
发送端:
function tcpsenchangefile(filename:string ;ip:string;port:integer; bar:TProgressBar;mainfrm:TForm;iconarr:array of TIcon):boolean; //发送文件
var
receivedString:string;
stream:TFileStream;
ReadCount : Integer;
Buf:array[0..1023]  of byte;
sendresult:boolean;  //发送结果
tcpclient:TIdTCPClient ;
begin
sendresult:=false;
tcpclient:=TIdTCPClient.Create(Application);
tcpclient.Host:=ip;
tcpclient.Port:=port;
if  not tcpclient.Connected then tcpclient.Connect(5000);
stream:=nil;
try
stream:=tfileStream.Create(filename,fmOpenRead);
if stream.Size>0 then tcpclient.WriteLn('token'+'|'+filename+'|'+IntToStr(stream.Size));
receivedString:=tcpclient.ReadLn(#13#10, 1000);
if uppercase(receivedString)=upperCase('agree-accept')then
begin
while stream.Position < stream.Size do
begin
if stream.Size - stream.Position >= SizeOf(Buf) then
ReadCount := sizeOf(Buf)
else ReadCount := stream.Size - stream.Position;
stream.ReadBuffer(Buf, ReadCount);
tcpclient.WriteBuffer(Buf, ReadCount);
//receivedString:=tcpclient.ReadLn(#13#10, 1000);
//if upperCase(ReceivedString)<>upperCase('receivedok') then    break;
changeico(mainfrm,softtitle, iconarr) ;
end;
tcpclient.WriteLn('tokenfilal');
receivedString:=tcpclient.ReadLn(#13#10, 1000);
if receivedString='receivefilal' then  sendresult:=true;
tcpclient.Disconnect;
end;
except
sendresult:=false;
end;
tcpclient.Disconnect;
if stream<>nil then FreeAndNil(stream);
if tcpclient<>nil then FreeAndNil(tcpclient);
Result:=sendresult;
end;

接受端
 procedure Tmainfrm.tcpserverExecute(AThread: TIdPeerThread);
 var
str ,receiveval:string;
temp:TStringList;
Buff : array[0..1023] of Byte; // Buff 缓存区大小设置,byte型
ReadCount : Integer; //实际每次读取文件块的大小,整型
begin
if not AThread.Terminated and AThread.Connection.Connected then
begin
if State= dstNone then
  receiveval := AThread.Connection.ReadLn(#13#10, 1000);
   if receiveval='' then Exit;
   temp:= SplitString(receiveval,'|');
   if protocol.IndexOf(temp[0])=0 then
    begin
    receiveFileName:=temp[1];
    receiveFileSize:=strtoint(temp[2]);
    filename:=createreceivedir(receiveFileName,receivedir);
    if not fileExists(filename) then
    stream:=TFileStream.Create(FileName,sysutils.fmOpenReadWrite or fmCreate)
    else
    stream:=TFileStream.Create(FileName,fmopenReadWrite);
    str:='agree-accept';
    AThread.Connection.WriteLn(str);
    State := dstReceiving;
    end
  else
  begin
    successfilesynchcount:=successfilesynchcount+1;
    str:='receivefilal';
    AThread.Connection.WriteLn(str);
    filename:='';
    receiveFileName:='';
    receiveFileSize:=0;
    receivsize:=0;
    softtitle:='目前成功接受'+inttostr(successfilesynchcount)+'个文件!';
  end;
 end;
   if stream<>nil then
   begin
    repeat
    if   receiveFileSize - Stream.Size > SizeOf(Buff) then
    ReadCount := SizeOf(Buff)
    else
    ReadCount := receiveFileSize - Stream.Size;
    AThread.Connection.ReadBuffer(Buff, ReadCount); //从连接中读取 ReadCount长度的文件块放到缓冲区Buff,中
    stream.WriteBuffer(Buff, ReadCount); //将缓冲区中的内容写进文件流中,这是就是写到文件aFileName中啦
    Bar.Position:=round(stream.size/receiveFileSize*100);
    Application.ProcessMessages; //这句作用是让消息传递动态显示起来,如果没有这句上面的caption是不会显示跳动的
    changeico(mainfrm,softtitle,   notifyicon) ;
   // str:='receivedok';
   // AThread.Connection.WriteLn(str);
    until Stream.Size >= receiveFileSize; //直到文件大小和原文件大小一致结束循环
    State := dstNone;
    stream.Free;
    stream:=nil;
   end;
end;
Tcp 发送大小文件测试过程中全部成功!这说明TCP发送文件可靠性比较强!算法要求低。
上面的算法有些变量没有写全 但核心代码没有问题 测试通过!

Wednesday, 18 April 2018

Delphi获取目录下所有文件名,子目录名-南山古桃(转+修改)-关键词:Delphi,获取文件名,子目录名

procedure    searchfile(path:string);//注意,path后面要有'\';
var
   SearchRec:TSearchRec;
   found:integer;
begin
   found:=FindFirst(path+'*.*',faAnyFile,SearchRec);
   while    found=0    do
     begin
         if    (SearchRec.Name<>'.')    and    (SearchRec.Name<>'..')
               and    (SearchRec.Attr<>faDirectory)    then
             begin
               Form1.ListBox1.Items.Add(SearchRec.Name);
             end;
         found:=FindNext(SearchRec);
     end;
   FindClose(SearchRec);
end;


http://taochaotc.blog.163.com/blog/static/1733711620085109343731/

Tuesday, 17 April 2018

文件名函数可以对文件的名称、所在子目录、驱动器和扩展名等进行操作

函数说明
 
ExpandFileName() //返回文件的全路径(含驱动器、路径)
 
ExtractFileExt() //从文件名中抽取扩展名
 
ExtractFileName() //从文件名中抽取不含路径的文件名
 
ExtractFilePath() //从文件名中抽取路径名
 
ExtractFileDir() //从文件名中抽取目录名
 
ExtractFileDrive() //从文件名中抽取驱动器名
 
ChangeFileExt() //改变文件的扩展名
 
ExpandUNCFileName() //返回含有网络驱动器的文件全路径
 
ExtractRelativePath() //从文件名中抽取相对路径信息
 
ExtractShortPathName() //把文件名转化为DOS的8·3格式
 
MatchesMask() //检查文件是否与指定的文件名格式匹配
 
ExtractFilePath(FileName:String) //该函数返回路径名,其结尾字符总是“\”
 
ExtractFileDir(FileName:String) //该函数同样返回路径名,但不包括结尾的字符“\”,除非返回的路径是根目录。

Thursday, 12 April 2018

except on E

            try 
            Except on E : Exception do
                    begin
                            ShowMessage('Timeout Error, dont worry');
                    end;
            end;

Wednesday, 11 April 2018

成功手机和电脑互传


Indy10 TrivialFTP client

https://www.experts-exchange.com/questions/22980786/Indy10-TrivialFTP-client.html

there seems to be some bug in indy

go in idtrivialftp.pas, line 272 in latest indy 10.

looe for the line
        CurrentDataBlk := WordToStr(GStack.HostToNet
work(Word(TFTP_DATA))) + WordToStr(GStack.HostToNetwork(BlockCtr));

and make it look like

        CurrentDataBlk := WordToStr(GStack.HostToNetwork(Word(TFTP_DATA))) + WordToStr(GStack.HostToNetwork(word(BlockCtr)));

notice the word explicit type conversion of BlockCtr

this fixes the range check error. (I thought you got a compiler warnign :D )

then, on line 274 uncomment the line

        SourceStream.ReadBuffer(CurrentDataBlk[hdrsize+1], DataLen);

and that should do it. the example at least, clicking on button2, will upload that text from the memory stream)

[vcl worked]Getting local IP address in Delphi

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Winsock;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

Function GetIPAddress():String;
type
  pu_long = ^u_long;
var
  varTWSAData : TWSAData;
  varPHostEnt : PHostEnt;
  varTInAddr : TInAddr;
// sypoh namebuf : Array[0..255] of char;
  namebuf: array [0..63] of Ansichar;
begin
  If WSAStartup($101,varTWSAData) <> 0 Then
  Result := 'No. IP Address'
  Else Begin
    gethostname(namebuf,sizeof(namebuf));

    varPHostEnt := gethostbyname(namebuf);
    varTInAddr.S_addr := u_long(pu_long(varPHostEnt^.h_addr_list^)^);
    Result := 'IP Address: '+inet_ntoa(varTInAddr);
  End;
  WSACleanup;
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
 Label1.Caption := GetIPAddress;
end;

end.

IdTrivialFTP1

http://borland.newsgroups.archived.at/public.delphi.internet.winsock/200805/08050813988.html

My First Copy Cat


Thursday, 5 April 2018

Android实例-路径信息及文件和文件夹的操作



unit Unit1;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.ScrollBox,
  FMX.Memo, FMX.Controls.Presentation, FMX.StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
uses
  System.IoUtils;
{$R *.fmx}
{$R *.NmXhdpiPh.fmx ANDROID}

procedure TForm1.Button1Click(Sender: TObject);
begin
  Memo1.Lines.Clear;
  Memo1.Lines.Add('GetTempFileName:' + TPath.GetTempFileName);
  Memo1.Lines.Add('GetTempPath:' + TPath.GetTempPath);
  Memo1.Lines.Add('GetHomePath:' + TPath.GetHomePath);
  Memo1.Lines.Add('GetDocumentsPath:' + TPath.GetDocumentsPath);
  Memo1.Lines.Add('GetSharedDocumentsPath:' + TPath.GetSharedDocumentsPath);
  Memo1.Lines.Add('GetLibraryPath:' + TPath.GetLibraryPath);
  Memo1.Lines.Add('GetCachePath:' + TPath.GetCachePath);
  Memo1.Lines.Add('GetPathRoot:' + TPath.GetPathRoot(TPath.GetCachePath));
  Memo1.Lines.Add('GetPublicPath:' + TPath.GetPublicPath);
  Memo1.Lines.Add('GetPicturesPath:' + TPath.GetPicturesPath);
  Memo1.Lines.Add('GetSharedPicturesPath:' + TPath.GetSharedPicturesPath);
  Memo1.Lines.Add('GetCameraPath:' + TPath.GetCameraPath);
  Memo1.Lines.Add('GetSharedCameraPath:' + TPath.GetSharedCameraPath);
  Memo1.Lines.Add('GetMusicPath:' + TPath.GetMusicPath);
  Memo1.Lines.Add('GetSharedMusicPath:' + TPath.GetSharedMusicPath);
  Memo1.Lines.Add('GetMoviesPath:' + TPath.GetMoviesPath);
  Memo1.Lines.Add('GetAlarmsPath:' + TPath.GetAlarmsPath);
  Memo1.Lines.Add('GetSharedAlarmsPath:' + TPath.GetSharedAlarmsPath);
  Memo1.Lines.Add('GetDownloadsPath:' + TPath.GetDownloadsPath);
  Memo1.Lines.Add('GetSharedDownloadsPath:' + TPath.GetSharedDownloadsPath);
  Memo1.Lines.Add('GetRingtonesPath:' + TPath.GetRingtonesPath);
  Memo1.Lines.Add('GetSharedRingtonesPath:' + TPath.GetSharedRingtonesPath);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  if TFile.Exists(TPath.GetTempFileName) then
  begin
    Memo1.Lines.Clear;
    Memo1.Lines.Add('存在');
  end;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  if not TDirectory.Exists(TPath.GetTempPath + 'NewDirectory') then
    TDirectory.CreateDirectory(TPath.GetTempPath + 'NewDirectory');
end;

procedure TForm1.Button4Click(Sender: TObject);
var
  sFile1: string;
  sFile2: string;
begin
  sFile1 := TPath.GetTempPath + '123.jpg';
  sFile2 := TPath.GetTempPath + '456.jpg';
  if not TFile.Exists(sFile1) then
  begin
    TFile.Copy(sFile1, sFile2);
  end;
end;

procedure TForm1.Button5Click(Sender: TObject);
var
  Files: TStringDynArray;
  I: Integer;
begin
  if TDirectory.Exists(TPath.GetTempPath + '/temp/') then
  begin
    Files := TDirectory.GetFiles(TPath.GetTempPath + '/temp/');
    for I := 0 to high(Files) do
    begin
      TFile.Delete(Files[I]);
    end;
  end;
end;

end.


zomok E-commerce system plan. Choose your online ordering system. No-risk 30 day free trial. Then USD 9/month. No credit card required.

zomok E-commerce system plan. Choose your online ordering system. No-risk 30 day free trial. Then USD 9/month. No credit card required. h...