UDP ile dosya al-gonder

unit Unit1;

 

interface

 

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, IdBaseComponent, IdComponent, IdUDPBase, IdUDPServer,idsockethandle,

  Gauges;

 

type

  TForm1 = class(TForm)

    IdUDPServer1: TIdUDPServer;

    SaveDialog1: TSaveDialog;

    Gauge1: TGauge;

    procedure IdUDPServer1UDPRead(Sender: TObject; AData: TStream;

      ABinding: TIdSocketHandle);

    procedure FormClose(Sender: TObject; var Action: TCloseAction);

  private

    FileName:string;//±£´æÊÕµ½µÄÎļşÃû

    FileSize:integer;//ÎļşµÄÕÒ¶È

    mem:tFileStream;

    { Private declarations }

  public

    { Public declarations }

  end;

 

var

  Form1: TForm1;

 

implementation

 

{$R *.dfm}

 

procedure TForm1.IdUDPServer1UDPRead(Sender: TObject; AData: TStream;

  ABinding: TIdSocketHandle);

var

  str:string;

begin

  aData.Seek(0,0);

  setLength(str,aData.size);

  aData.Read(str[1],aData.Size);

  if pos('Send File:File name:',str)>0 then begin

    delete(str,1,length('Send File:File name:'));

    fileName:=str;

    //showmessage(str);

    str:='Received File ok';

    abinding.SendTo(aBinding.PeerIP,aBindIng.PeerPort,str[1],length(str));

   // idUDPserver1.Send(idUDPServer1.);

  end else if pos('File Length:',str)>0 then begin

    delete(str,1,length('File Length:'));

    FileSize:=strToIntDef(str,0);

    SaveDialog1.FileName:=fileName;

    if saveDialog1.Execute then begin

      FileName:=saveDialog1.FileName;

      if FileExists(filename) then

         deleteFile(filename);

      if mem<>nil then begin

        mem.Free;

        mem:=nil;

      end;

      if not fileExists(FileName) then

        mem:=TFileStream.Create(FileName,sysutils.fmOpenReadWrite or fmCreate)

      else

        mem:=TFileStream.Create(FileName,fmopenReadWrite);

      str:='get file Length ok';

      aBinding.SendTo(aBinding.PeerIP,aBinding.PeerPort,str[1],length(str));

    end else begin    //saveDialog1.execute

      str:='received File cancel';

      aBinding.SendTo(aBinding.PeerIP,aBinding.PeerPort,str[1],length(str));

    end;

  end else if pos('File Send End',str)>0 then begin

    if mem<>nil then begin

      mem.Free;

      mem:=nil;

      str:='Received File Successed';

      aBinding.SendTo(aBinding.PeerIP,aBinding.PeerPort,str[1],length(str));

      filename:='';

      fileSize:=0;

    end;

  end else begin

    if mem<>nil then begin

      mem.Seek(0,2);

      aData.Seek(0,0);

      mem.CopyFrom(aData,aData.Size);

      gauge1.Progress:=round(mem.size/fileSize*100);

      str:='received ok';

      abinding.SendTo(aBinding.PeerIP,aBinding.PeerPort,str[1],length(str));

      application.ProcessMessages;

    end;

 

  end;

 

end;

 

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin

  if mem<>nil then

    mem.Free;

end;

 

end.

 

=====================================

 

 

 

===============¿Í»§¶Ë================

unit Unit1;

 

interface

 

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls, Gauges, IdBaseComponent, IdComponent, IdUDPBase,

  IdUDPClient;

 

type

  TForm1 = class(TForm)

    Edit1: TEdit;

    IdUDPClient1: TIdUDPClient;

    Gauge1: TGauge;

    Button1: TButton;

    OpenDialog1: TOpenDialog;

    procedure Button1Click(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

 

var

  Form1: TForm1;

 

implementation

 

{$R *.dfm}

 

procedure TForm1.Button1Click(Sender: TObject);

var

  receivedString:string;

  mem:tfileStream;

  posi,len:integer;

  p:array [0..1023] of byte;

begin

  if opendialog1.Execute then begin

    idUDPClient1.Host:=edit1.Text;

    idUDPClient1.Active:=true;

 

    idUDPClient1.Send('Send File:File name:'+opendialog1.FileName);

    ReceivedString:=idUDPClient1.ReceiveString;

    if uppercase(Receivedstring)=upperCase('Received File ok') then

    begin

      //showmessage('·şÎñÆ÷ÌáʾÊÕµ½ÎļşÃû');

      mem:=tfileStream.Create(opendialog1.FileName,fmOpenRead);

      try

        posi:=0;

        idUDPclient1.Send('File Length:'+IntToStr(mem.Size));

        receivedString:=idUDPClient1.ReceiveString();

        if uppercase(receivedString)=upperCase('get file Length ok') then begin

           while posi<mem.Size  do begin

             len:=1024;             //Ö»ÄÜ·¢ 1024

             if mem.Size<1024 then  //Èç¹û³¤¶È²»µ½ 1024

               len:=mem.Size;

             mem.Read(p,len);

             idUDPClient1.SendBuffer(p,len);

             inc(posi,len);

             gauge1.Progress:=round(posi/mem.size*100);

             receivedString:=idUDPClient1.ReceiveString();

             if upperCase(ReceivedString)<>upperCase('received ok') then

               break;

             application.ProcessMessages;

           end;    //end while

           idUDPClient1.Send('File Send End');

           if idUdpClient1.ReceiveString()='Received File Successed' then

             showmessage('Îļş³É¹¦·¢ËÍ');

         end else showmessage('cancel');// end while

       //end È¡µÃÎļş³¤¶È

      finally

        mem.Free;

      end;

    end;

  end;//opendialog1.execute

end;

 

end.

 

**********************************************Örnek 2

procedure TFormClient.Button1Click(Sender: TObject);

Var  ReceivedString:String;

  Mem:TFileStream;

  p:Array[0..1023] of byte;

  Posi,Len:Integer;

begin

  if OpenDialog1.Execute then

  begin

    IdUDPClient1.Host:=Edit1.Text;

    IdUDPClient1.Active:=True;

    IdUDPClient1.Send('Send file:File Name:'+OpenDialog1.FileName);

    ReceivedString := IdUDPClient1.ReceiveString();

    if UpperCase(ReceivedString)='RECIVED FILE NAME OK!' then

    begin

      Mem:=TFileStream.Create(OpenDialog1.FileName,fmOpenRead);

      try

        Posi:=0;

        IdUDPClient1.Send('Send File:File Length:'+IntToStr(Mem.Size));

        ReceivedString := IdUDPClient1.ReceiveString();

        if UpperCase(ReceivedString)='RECIVED FILE LENGTH OK!' then

        begin

          While Posi<Mem.Size do//&#65426;&#65403;&#65396;&#65422;&#65430;&#65403;&#65399;&#65378;1024&#65400;¡x&#65430;&#65405;&#65434;,&#65431;&#65430;&#65405;&#65434;&#65418;&#63729;&#65394;&#65403;&#65412;&#65436;&#65420;&#65387;&#65398;&#12539;&#65394;&#65403;&#65401;&#63729;&#65427;&#65382;&#65400;&#65411;&#65403;&#65401;&#65407;&#65417;&#65426;&#65428;&#65428;¡]&#65427;&#65426;&#65403;&#65424;&#65385;.

          begin

            Len:=1024;

            if Mem.Size-Posi<1024 then

              Len:=Mem.Size-Posi;

            Mem.Read(p,Len);

            IdUDPClient1.SendBuffer(P,Len);

            Inc(Posi,Len);

            Gauge1.Progress:=Round(Posi/Mem.Size*100);

            ReceivedString := IdUDPClient1.ReceiveString();

            if UpperCase(ReceivedString)<>'RECIVED FILE PACKAGE OK!' then

              Break;

            Application.ProcessMessages;

          end;

          IdUDPClient1.Send('Send File:File End!');

        end else

          ShowMessage('Send file cancel!');

      finally

        Mem.Free;

      end;

    end;

  end;

end;

 

·şÎñÆ÷¶Ë

procedure TFormServer.IdUDPServer1UDPRead(Sender: TObject; AData: TStream;

  ABinding: TIdSocketHandle);

Var Str:String;

begin

  AData.Seek(0,0);

  SetLength(Str,AData.Size);

  AData.Read(Str[1],AData.Size);

  if Pos('Send file:File Name:',Str)>0 then

  begin

    Delete(Str,1,Length('Send file:File Name:'));

    FileName:=Str;

    Str:='Recived File Name OK!';

    ABinding.SendTo(ABinding.PeerIP, ABinding.PeerPort, Str[1], Length(Str));

  end else if Pos('Send File:File Length:',Str)>0 then

  begin

    Delete(Str,1,Length('Send File:File Length:'));

    FileSize:=StrToIntDef(Str,0);

    SaveDialog1.FileName:=FileName;

    if SaveDialog1.Execute then

    begin

      FileName:=SaveDialog1.FileName;

      if FileExists(FileName) then

        DeleteFile(FileName);

      if Mem<>nil then

      begin

        Mem.Free;

        Mem:=nil;

      end;

      if not FileExists(FileName) then

        Mem:=TFileStream.Create(FileName,fmOpenReadWrite or fmCreate)

      else

        Mem:=TFileStream.Create(FileName,fmOpenReadWrite);

      Str:='Recived File Length OK!';

      ABinding.SendTo(ABinding.PeerIP, ABinding.PeerPort, Str[1], Length(Str));

    end else

    begin

      Str:='Recived File Length Cancel!';

      ABinding.SendTo(ABinding.PeerIP, ABinding.PeerPort, Str[1], Length(Str));

    end;

  end else if Pos('Send File:File End!',Str)>0 then

  begin

    if Mem<>nil then

    begin

      Mem.Free;

      Mem:=nil;

      Str:='Recived File OK!';

      ABinding.SendTo(ABinding.PeerIP, ABinding.PeerPort, Str[1], Length(Str));

    end;

    FileName:='';

    FileSize:=0;

  end

  else

  begin

    if Mem<>nil then

    begin

      Mem.Seek(0,2);

      AData.Seek(0,0);

      Mem.CopyFrom(AData,AData.Size);

      Gauge1.Progress:=Round(Mem.Size/FileSize*100);

      Str:='Recived File Package OK!';

      ABinding.SendTo(ABinding.PeerIP, ABinding.PeerPort, Str[1], Length(Str));

      Application.ProcessMessages;

    end;

  end;

end;

 

procedure TFormServer.FormCreate(Sender: TObject);

begin

  IdUDPServer1.Active:=True;

  FileName:='';

  FileSize:=0;

  Mem:=nil;

end;

 

procedure TFormServer.FormDestroy(Sender: TObject);

begin

  if Mem<>nil then

    Mem.Free;

end;

 

Delphi - .....................................

 

UDP ile dosya al-gonder

unit Unit1;

 

interface

 

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, IdBaseComponent, IdComponent, IdUDPBase, IdUDPServer,idsockethandle,

  Gauges;

 

type

  TForm1 = class(TForm)

    IdUDPServer1: TIdUDPServer;

    SaveDialog1: TSaveDialog;

    Gauge1: TGauge;

    procedure IdUDPServer1UDPRead(Sender: TObject; AData: TStream;

      ABinding: TIdSocketHandle);

    procedure FormClose(Sender: TObject; var Action: TCloseAction);

  private

    FileName:string;//±£´æÊÕµ½µÄÎļşÃû

    FileSize:integer;//ÎļşµÄÕÒ¶È

    mem:tFileStream;

    { Private declarations }

  public

    { Public declarations }

  end;

 

var

  Form1: TForm1;

 

implementation

 

{$R *.dfm}

 

procedure TForm1.IdUDPServer1UDPRead(Sender: TObject; AData: TStream;

  ABinding: TIdSocketHandle);

var

  str:string;

begin

  aData.Seek(0,0);

  setLength(str,aData.size);

  aData.Read(str[1],aData.Size);

  if pos('Send File:File name:',str)>0 then begin

    delete(str,1,length('Send File:File name:'));

    fileName:=str;

    //showmessage(str);

    str:='Received File ok';

    abinding.SendTo(aBinding.PeerIP,aBindIng.PeerPort,str[1],length(str));

   // idUDPserver1.Send(idUDPServer1.);

  end else if pos('File Length:',str)>0 then begin

    delete(str,1,length('File Length:'));

    FileSize:=strToIntDef(str,0);

    SaveDialog1.FileName:=fileName;

    if saveDialog1.Execute then begin

      FileName:=saveDialog1.FileName;

      if FileExists(filename) then

         deleteFile(filename);

      if mem<>nil then begin

        mem.Free;

        mem:=nil;

      end;

      if not fileExists(FileName) then

        mem:=TFileStream.Create(FileName,sysutils.fmOpenReadWrite or fmCreate)

      else

        mem:=TFileStream.Create(FileName,fmopenReadWrite);

      str:='get file Length ok';

      aBinding.SendTo(aBinding.PeerIP,aBinding.PeerPort,str[1],length(str));

    end else begin    //saveDialog1.execute

      str:='received File cancel';

      aBinding.SendTo(aBinding.PeerIP,aBinding.PeerPort,str[1],length(str));

    end;

  end else if pos('File Send End',str)>0 then begin

    if mem<>nil then begin

      mem.Free;

      mem:=nil;

      str:='Received File Successed';

      aBinding.SendTo(aBinding.PeerIP,aBinding.PeerPort,str[1],length(str));

      filename:='';

      fileSize:=0;

    end;

  end else begin

    if mem<>nil then begin

      mem.Seek(0,2);

      aData.Seek(0,0);

      mem.CopyFrom(aData,aData.Size);

      gauge1.Progress:=round(mem.size/fileSize*100);

      str:='received ok';

      abinding.SendTo(aBinding.PeerIP,aBinding.PeerPort,str[1],length(str));

      application.ProcessMessages;

    end;

 

  end;

 

end;

 

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin

  if mem<>nil then

    mem.Free;

end;

 

end.

 

=====================================

 

 

 

===============¿Í»§¶Ë================

unit Unit1;

 

interface

 

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls, Gauges, IdBaseComponent, IdComponent, IdUDPBase,

  IdUDPClient;

 

type

  TForm1 = class(TForm)

    Edit1: TEdit;

    IdUDPClient1: TIdUDPClient;

    Gauge1: TGauge;

    Button1: TButton;

    OpenDialog1: TOpenDialog;

    procedure Button1Click(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

 

var

  Form1: TForm1;

 

implementation

 

{$R *.dfm}

 

procedure TForm1.Button1Click(Sender: TObject);

var

  receivedString:string;

  mem:tfileStream;

  posi,len:integer;

  p:array [0..1023] of byte;

begin

  if opendialog1.Execute then begin

    idUDPClient1.Host:=edit1.Text;

    idUDPClient1.Active:=true;

 

    idUDPClient1.Send('Send File:File name:'+opendialog1.FileName);

    ReceivedString:=idUDPClient1.ReceiveString;

    if uppercase(Receivedstring)=upperCase('Received File ok') then

    begin

      //showmessage('·şÎñÆ÷ÌáʾÊÕµ½ÎļşÃû');

      mem:=tfileStream.Create(opendialog1.FileName,fmOpenRead);

      try

        posi:=0;

        idUDPclient1.Send('File Length:'+IntToStr(mem.Size));

        receivedString:=idUDPClient1.ReceiveString();

        if uppercase(receivedString)=upperCase('get file Length ok') then begin

           while posi<mem.Size  do begin

             len:=1024;             //Ö»ÄÜ·¢ 1024

             if mem.Size<1024 then  //Èç¹û³¤¶È²»µ½ 1024

               len:=mem.Size;

             mem.Read(p,len);

             idUDPClient1.SendBuffer(p,len);

             inc(posi,len);

             gauge1.Progress:=round(posi/mem.size*100);

             receivedString:=idUDPClient1.ReceiveString();

             if upperCase(ReceivedString)<>upperCase('received ok') then

               break;

             application.ProcessMessages;

           end;    //end while

           idUDPClient1.Send('File Send End');

           if idUdpClient1.ReceiveString()='Received File Successed' then

             showmessage('Îļş³É¹¦·¢ËÍ');

         end else showmessage('cancel');// end while

       //end È¡µÃÎļş³¤¶È

      finally

        mem.Free;

      end;

    end;

  end;//opendialog1.execute

end;

 

end.

 

**********************************************Örnek 2

procedure TFormClient.Button1Click(Sender: TObject);

Var  ReceivedString:String;

  Mem:TFileStream;

  p:Array[0..1023] of byte;

  Posi,Len:Integer;

begin

  if OpenDialog1.Execute then

  begin

    IdUDPClient1.Host:=Edit1.Text;

    IdUDPClient1.Active:=True;

    IdUDPClient1.Send('Send file:File Name:'+OpenDialog1.FileName);

    ReceivedString := IdUDPClient1.ReceiveString();

    if UpperCase(ReceivedString)='RECIVED FILE NAME OK!' then

    begin

      Mem:=TFileStream.Create(OpenDialog1.FileName,fmOpenRead);

      try

        Posi:=0;

        IdUDPClient1.Send('Send File:File Length:'+IntToStr(Mem.Size));

        ReceivedString := IdUDPClient1.ReceiveString();

        if UpperCase(ReceivedString)='RECIVED FILE LENGTH OK!' then

        begin

          While Posi<Mem.Size do//&#65426;&#65403;&#65396;&#65422;&#65430;&#65403;&#65399;&#65378;1024&#65400;¡x&#65430;&#65405;&#65434;,&#65431;&#65430;&#65405;&#65434;&#65418;&#63729;&#65394;&#65403;&#65412;&#65436;&#65420;&#65387;&#65398;&#12539;&#65394;&#65403;&#65401;&#63729;&#65427;&#65382;&#65400;&#65411;&#65403;&#65401;&#65407;&#65417;&#65426;&#65428;&#65428;¡]&#65427;&#65426;&#65403;&#65424;&#65385;.

          begin

            Len:=1024;

            if Mem.Size-Posi<1024 then

              Len:=Mem.Size-Posi;

            Mem.Read(p,Len);

            IdUDPClient1.SendBuffer(P,Len);

            Inc(Posi,Len);

            Gauge1.Progress:=Round(Posi/Mem.Size*100);

            ReceivedString := IdUDPClient1.ReceiveString();

            if UpperCase(ReceivedString)<>'RECIVED FILE PACKAGE OK!' then

              Break;

            Application.ProcessMessages;

          end;

          IdUDPClient1.Send('Send File:File End!');

        end else

          ShowMessage('Send file cancel!');

      finally

        Mem.Free;

      end;

    end;

  end;

end;

 

·şÎñÆ÷¶Ë

procedure TFormServer.IdUDPServer1UDPRead(Sender: TObject; AData: TStream;

  ABinding: TIdSocketHandle);

Var Str:String;

begin

  AData.Seek(0,0);

  SetLength(Str,AData.Size);

  AData.Read(Str[1],AData.Size);

  if Pos('Send file:File Name:',Str)>0 then

  begin

    Delete(Str,1,Length('Send file:File Name:'));

    FileName:=Str;

    Str:='Recived File Name OK!';

    ABinding.SendTo(ABinding.PeerIP, ABinding.PeerPort, Str[1], Length(Str));

  end else if Pos('Send File:File Length:',Str)>0 then

  begin

    Delete(Str,1,Length('Send File:File Length:'));

    FileSize:=StrToIntDef(Str,0);

    SaveDialog1.FileName:=FileName;

    if SaveDialog1.Execute then

    begin

      FileName:=SaveDialog1.FileName;

      if FileExists(FileName) then

        DeleteFile(FileName);

      if Mem<>nil then

      begin

        Mem.Free;

        Mem:=nil;

      end;

      if not FileExists(FileName) then

        Mem:=TFileStream.Create(FileName,fmOpenReadWrite or fmCreate)

      else

        Mem:=TFileStream.Create(FileName,fmOpenReadWrite);

      Str:='Recived File Length OK!';

      ABinding.SendTo(ABinding.PeerIP, ABinding.PeerPort, Str[1], Length(Str));

    end else

    begin

      Str:='Recived File Length Cancel!';

      ABinding.SendTo(ABinding.PeerIP, ABinding.PeerPort, Str[1], Length(Str));

    end;

  end else if Pos('Send File:File End!',Str)>0 then

  begin

    if Mem<>nil then

    begin

      Mem.Free;

      Mem:=nil;

      Str:='Recived File OK!';

      ABinding.SendTo(ABinding.PeerIP, ABinding.PeerPort, Str[1], Length(Str));

    end;

    FileName:='';

    FileSize:=0;

  end

  else

  begin

    if Mem<>nil then

    begin

      Mem.Seek(0,2);

      AData.Seek(0,0);

      Mem.CopyFrom(AData,AData.Size);

      Gauge1.Progress:=Round(Mem.Size/FileSize*100);

      Str:='Recived File Package OK!';

      ABinding.SendTo(ABinding.PeerIP, ABinding.PeerPort, Str[1], Length(Str));

      Application.ProcessMessages;

    end;

  end;

end;

 

procedure TFormServer.FormCreate(Sender: TObject);

begin

  IdUDPServer1.Active:=True;

  FileName:='';

  FileSize:=0;

  Mem:=nil;

end;

 

procedure TFormServer.FormDestroy(Sender: TObject);

begin

  if Mem<>nil then

    Mem.Free;

end;

 

Delphi - .....................................

 

Stream örneği

TStream = class(TObject)

  private

    function GetPosition: Int64;

    procedure SetPosition(const Pos: Int64);

    procedure SetSize64(const NewSize: Int64);

  protected

    function GetSize: Int64; virtual;

    procedure SetSize(NewSize: Longint); overload; virtual;

    procedure SetSize(const NewSize: Int64); overload; virtual;

  public

    function Read(var Buffer; Count: Longint): Longint; virtual; abstract;

    function Write(const Buffer; Count: Longint): Longint; virtual; abstract;

    function Seek(Offset: Longint; Origin: Word): Longint; overload; virtual;

    function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; overload; virtual;

    procedure ReadBuffer(var Buffer; Count: Longint);

    procedure WriteBuffer(const Buffer; Count: Longint);

    function CopyFrom(Source: TStream; Count: Int64): Int64;

    function ReadComponent(Instance: TComponent): TComponent;

    function ReadComponentRes(Instance: TComponent): TComponent;

    procedure WriteComponent(Instance: TComponent);

    procedure WriteComponentRes(const ResName: string; Instance: TComponent);

    procedure WriteDescendent(Instance, Ancestor: TComponent);

    procedure WriteDescendentRes(const ResName: string; Instance, Ancestor: TComponent);

    procedure WriteResourceHeader(const ResName: string; out FixupInfo: Integer);

    procedure FixupResourceHeader(FixupInfo: Integer);

    procedure ReadResHeader;

    property Position: Int64 read GetPosition write SetPosition;

    property Size: Int64 read GetSize write SetSize64;

  end;

 

  IStreamPersist = interface

    ['{B8CD12A3-267A-11D4-83DA-00C04F60B2DD}']

    procedure LoadFromStream(Stream: TStream);

    procedure SaveToStream(Stream: TStream);

  end;

 

procedure TForm1.BtnWriteClick(Sender: TObject);

  { by:  Michael Vincze

  }

  var

    FileStream: TFileStream;

    Writer    : TWriter;

    I         : Integer;

  begin

  FileStream := TFileStream.Create ('c:delphiprojectsdelta40fileiostream.txt',

    fmCreate or fmOpenWrite or fmShareDenyNone);

  Writer := TWriter.Create (FileStream, $ff);

  Writer.WriteListBegin;

  for I := 0 to Memo1.Lines.Count - 1 do Writer.WriteString (Memo1.Lines[I]);

  Writer.WriteListEnd;

  Writer.Destroy;

  FileStream.Destroy;

  end;

 

  procedure TForm1.BtnReadClick(Sender: TObject);

  { by:  Michael Vincze

  }

  var

    FileStream: TFileStream;

    Reader    : TReader;

  begin

  { try opening a non existent file

  }

  try

    FileStream := TFileStream.Create ('c:delphiprojectsdelta40fileiobogus.txt',

      fmOpenRead);

  except

    ; { no need to Destroy since the Create failed  }

    end;

 

  FileStream := TFileStream.Create ('c:delphiprojectsdelta40fileiostream.txt',

    fmOpenRead);

  Reader := TReader.Create (FileStream, $ff);

  Reader.ReadListBegin;

  Memo1.Lines.Clear;

  while not Reader.EndOfList do Memo1.Lines.Add (Reader.ReadString);

  Reader.ReadListEnd;

  Reader.Destroy;

  FileStream.Destroy;

  end;

 

 

 

 

 Suppose you declare a Source- and Destname, with read and writebuffer you can copy source to destination in a manageable way, then you create the destination-filename on the client:

// sSourceFileName:= ReadString(sStartFile); from Registry

// sDestFileName:= sDestPath + ExtractFileName(sSourceFileName);

 

const   cDataSize = 2048;

var     Reg: TRegistry; //Source is stored in the Reg

        fsSource, fsDestination : TFileStream;

        sExecCall : string;

        pBuffer: Pointer;

        iSize, i: integer;

 

The mainroutine opens two FileStream-objects and copys with read- and writebuffer a predefined size (2048) from the source to the destination. In the meantime a progressbar is updated until fileSize.

 

  try

     fsSource:= TFileStream.Create (sSourceFileName, fmOpenRead);

     fsDestination:= TFileStream.Create(sDestFileName, fmCreate);

        iSize:= fsSource.Size;

        //normal way with CopyFrom!

        //fsDestination.CopyFrom (fsSource, fsSource.Size);

        ProgressBar1.Max:= fsSource.Size;

        GetMem(pBuffer, cDataSize);

        i:= 1;

        while i * cDataSize <= iSize do begin

          fsSource.ReadBuffer (pBuffer^, cDataSize);

          fsDestination.WriteBuffer (pBuffer^, cDataSize);

          ProgressBar1.Position:= i * cDataSize;

          inc(i);

        end;

      fsSource.ReadBuffer (pBuffer^, iSize- (i-1)* cDataSize);

      fsDestination.WriteBuffer (pBuffer^, iSize- (i-1)* cDataSize);

   finally

      fsSource.Free;

      fsDestination.Free;

   end;

 

The unit is available to download an needs further actions:

1. two name-entries in the registry in one key // HKEY_USERS

.DEFAULTSoftwareProsystemDynaLoader

      name              value

      myExe:            'path to exe'

      destinationPath:  'path to client'

 

2. create the file "regpath.txt" with the registryPath, for example:

// rem HKEY_USERS RegKey on server, 3.8.01

.DEFAULTSoftwareProsystemDynaLoader

 

3. start the loader from clients (a link-file) with two command-line options:

PROLOADER.EXE servername myExe

 

In our implementation it's only the link (of the loader) and the file on the client, the loader, the application and registry are on the server.

 

 

Update 07.04.02 copy a MemoryStream in a StringStream

-------------------------------------------------------

 

procedure TMainFrm.TemplateBtnClick(Sender: TObject);

var

  M: TMemoryStream;

  S: TStringStream;

begin

  M := TMemoryStream.Create;

  S := TStringStream.Create('');

  try

    M.LoadFromFile(ExtractFilePath(Application.ExeName)+ '/Test1.txt');

    M.Seek(0,0);

    // TStream.CopyFrom() method uses WriteBuffer()

           and ReadBuffer() template methods

    S.CopyFrom(M, M.Size);

    S.Seek(0,0);

    with Memo.Lines do begin

      Clear;

      Add(S.ReadString(S.Size));

    end;

  finally

    M.Free;

    S.Free;

  end;

end;

 

 

http://max.kleiner.com/download/processloader1.pas

 

Delphi - .....................................

 

Stream örneği

TStream = class(TObject)

  private

    function GetPosition: Int64;

    procedure SetPosition(const Pos: Int64);

    procedure SetSize64(const NewSize: Int64);

  protected

    function GetSize: Int64; virtual;

    procedure SetSize(NewSize: Longint); overload; virtual;

    procedure SetSize(const NewSize: Int64); overload; virtual;

  public

    function Read(var Buffer; Count: Longint): Longint; virtual; abstract;

    function Write(const Buffer; Count: Longint): Longint; virtual; abstract;

    function Seek(Offset: Longint; Origin: Word): Longint; overload; virtual;

    function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; overload; virtual;

    procedure ReadBuffer(var Buffer; Count: Longint);

    procedure WriteBuffer(const Buffer; Count: Longint);

    function CopyFrom(Source: TStream; Count: Int64): Int64;

    function ReadComponent(Instance: TComponent): TComponent;

    function ReadComponentRes(Instance: TComponent): TComponent;

    procedure WriteComponent(Instance: TComponent);

    procedure WriteComponentRes(const ResName: string; Instance: TComponent);

    procedure WriteDescendent(Instance, Ancestor: TComponent);

    procedure WriteDescendentRes(const ResName: string; Instance, Ancestor: TComponent);

    procedure WriteResourceHeader(const ResName: string; out FixupInfo: Integer);

    procedure FixupResourceHeader(FixupInfo: Integer);

    procedure ReadResHeader;

    property Position: Int64 read GetPosition write SetPosition;

    property Size: Int64 read GetSize write SetSize64;

  end;

 

  IStreamPersist = interface

    ['{B8CD12A3-267A-11D4-83DA-00C04F60B2DD}']

    procedure LoadFromStream(Stream: TStream);

    procedure SaveToStream(Stream: TStream);

  end;

 

procedure TForm1.BtnWriteClick(Sender: TObject);

  { by:  Michael Vincze

  }

  var

    FileStream: TFileStream;

    Writer    : TWriter;

    I         : Integer;

  begin

  FileStream := TFileStream.Create ('c:delphiprojectsdelta40fileiostream.txt',

    fmCreate or fmOpenWrite or fmShareDenyNone);

  Writer := TWriter.Create (FileStream, $ff);

  Writer.WriteListBegin;

  for I := 0 to Memo1.Lines.Count - 1 do Writer.WriteString (Memo1.Lines[I]);

  Writer.WriteListEnd;

  Writer.Destroy;

  FileStream.Destroy;

  end;

 

  procedure TForm1.BtnReadClick(Sender: TObject);

  { by:  Michael Vincze

  }

  var

    FileStream: TFileStream;

    Reader    : TReader;

  begin

  { try opening a non existent file

  }

  try

    FileStream := TFileStream.Create ('c:delphiprojectsdelta40fileiobogus.txt',

      fmOpenRead);

  except

    ; { no need to Destroy since the Create failed  }

    end;

 

  FileStream := TFileStream.Create ('c:delphiprojectsdelta40fileiostream.txt',

    fmOpenRead);

  Reader := TReader.Create (FileStream, $ff);

  Reader.ReadListBegin;

  Memo1.Lines.Clear;

  while not Reader.EndOfList do Memo1.Lines.Add (Reader.ReadString);

  Reader.ReadListEnd;

  Reader.Destroy;

  FileStream.Destroy;

  end;

 

 

 

 

 Suppose you declare a Source- and Destname, with read and writebuffer you can copy source to destination in a manageable way, then you create the destination-filename on the client:

// sSourceFileName:= ReadString(sStartFile); from Registry

// sDestFileName:= sDestPath + ExtractFileName(sSourceFileName);

 

const   cDataSize = 2048;

var     Reg: TRegistry; //Source is stored in the Reg

        fsSource, fsDestination : TFileStream;

        sExecCall : string;

        pBuffer: Pointer;

        iSize, i: integer;

 

The mainroutine opens two FileStream-objects and copys with read- and writebuffer a predefined size (2048) from the source to the destination. In the meantime a progressbar is updated until fileSize.

 

  try

     fsSource:= TFileStream.Create (sSourceFileName, fmOpenRead);

     fsDestination:= TFileStream.Create(sDestFileName, fmCreate);

        iSize:= fsSource.Size;

        //normal way with CopyFrom!

        //fsDestination.CopyFrom (fsSource, fsSource.Size);

        ProgressBar1.Max:= fsSource.Size;

        GetMem(pBuffer, cDataSize);

        i:= 1;

        while i * cDataSize <= iSize do begin

          fsSource.ReadBuffer (pBuffer^, cDataSize);

          fsDestination.WriteBuffer (pBuffer^, cDataSize);

          ProgressBar1.Position:= i * cDataSize;

          inc(i);

        end;

      fsSource.ReadBuffer (pBuffer^, iSize- (i-1)* cDataSize);

      fsDestination.WriteBuffer (pBuffer^, iSize- (i-1)* cDataSize);

   finally

      fsSource.Free;

      fsDestination.Free;

   end;

 

The unit is available to download an needs further actions:

1. two name-entries in the registry in one key // HKEY_USERS

.DEFAULTSoftwareProsystemDynaLoader

      name              value

      myExe:            'path to exe'

      destinationPath:  'path to client'

 

2. create the file "regpath.txt" with the registryPath, for example:

// rem HKEY_USERS RegKey on server, 3.8.01

.DEFAULTSoftwareProsystemDynaLoader

 

3. start the loader from clients (a link-file) with two command-line options:

PROLOADER.EXE servername myExe

 

In our implementation it's only the link (of the loader) and the file on the client, the loader, the application and registry are on the server.

 

 

Update 07.04.02 copy a MemoryStream in a StringStream

-------------------------------------------------------

 

procedure TMainFrm.TemplateBtnClick(Sender: TObject);

var

  M: TMemoryStream;

  S: TStringStream;

begin

  M := TMemoryStream.Create;

  S := TStringStream.Create('');

  try

    M.LoadFromFile(ExtractFilePath(Application.ExeName)+ '/Test1.txt');

    M.Seek(0,0);

    // TStream.CopyFrom() method uses WriteBuffer()

           and ReadBuffer() template methods

    S.CopyFrom(M, M.Size);

    S.Seek(0,0);

    with Memo.Lines do begin

      Clear;

      Add(S.ReadString(S.Size));

    end;

  finally

    M.Free;

    S.Free;

  end;

end;

 

 

http://max.kleiner.com/download/processloader1.pas

 

Delphi - .....................................

 

WakeOn Lan

WakeOnLan('00-D0-B7-E2-A1-A0');

Answer:

 

 

uses idUDPClient;

 

// ==========================================================================

// Wakes a machine on lan

// AMacAddress is 17 char MAC address.

// eg.  '00-C0-4F-0A-3A-D7'

// ==========================================================================

 

procedure WakeOnLan(const AMacAddress : string);

type

     TMacAddress = array [1..6] of byte;

 

     TWakeRecord = packed record

       Waker : TMACAddress;

       MAC   : array[0..15] of TMACAddress;

     end;

 

var i : integer;

    WR : TWakeRecord;

    MacAddress : TMacAddress;

    UDP : TIdUDPClient;

    sData : string;

begin

  // Convert MAC string into MAC array

  fillchar(MacAddress,SizeOf(TMacAddress),0);

  sData := trim(AMacAddress);

 

  if length(sData) = 17 then begin

    for i := 1 to 6 do begin

      MacAddress[i] := StrToIntDef('$' + copy(sData,1,2),0);

      sData := copy(sData,4,17);

    end;

  end;

 

  for i := 1 To 6 do WR.Waker[i] := $FF;

  for i := 0 to 15 do WR.MAC[i] := MacAddress;

  // Create UDP and Broadcast data structure

  UDP := TIdUDPClient.Create(nil);

  UDP.Host := '255.255.255.255';

  UDP.Port := 32767;

  UDP.BroadCastEnabled := true;

  UDP.SendBuffer(WR,SizeOf(TWakeRecord));

  UDP.BroadcastEnabled := false;

  UDP.Free;

end;

 

Delphi - .....................................