unit1.~pas

自动升级控件源代码

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ScktComp, ExtCtrls,StrUtils,IniFiles,
  te_controls, ksthemeforms, ksthemeengine, ComCtrls;
 Const
MP_QUERY ='11111';
MP_REFUSE ='22222';
MP_ACCEPT ='33333';
MP_NEXTWILLBEDATA='44444';
MP_DATA ='55555';
MP_ABORT ='66666';
MP_OVER ='77777';
MP_CHAT ='88888';
MP_END='99999';
MP_FILEPROPERTY='00000';
iBYTEPERSEND=1024;
type
  TForm1 = class(TForm)
    Panel1: TPanel;
    CS1: TClientSocket;
    SS1: TServerSocket;
    BitBtn1: TBitBtn;
    Timer1: TTimer;
    Memo1: TMemo;
    TeThemeEngine1: TTeThemeEngine;
    TeThemeForm1: TTeThemeForm;
    Timer2: TTimer;
    StatusBar1: TStatusBar;
    procedure BitBtn1Click(Sender: TObject);
    procedure SS1ClientRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure FormShow(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure CS1Read(Sender: TObject; Socket: TCustomWinSocket);
    procedure Timer1Timer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Timer2Timer(Sender: TObject);
  private
    { Private declarations }

     fsSend: TFileStream;
    bStart:Boolean;
    TickCount:Longword;
  public
    { Public declarations }
   Procedure RINI(Sender: TObject); //读取ini文件;
   Function ConnectTo(S:string):boolean;

  end;

var
  Form1: TForm1;
  CurrentVer,CurrentDir,UPip,SoftPath,SoftName:string;


implementation

{$R *.dfm}

Function Tform1.ConnectTo(S:string):boolean;
begin
    try
      cs1.Active:=false;
      CS1.Address:=S;
      CS1.Port:=7000;
      cs1.Active:=true;

     // cs2.Active:=false;
     // cs2.Address:=s;
     // cs2.Port:=8000;
     // cs2.Active:=true;

      except
      Messagedlg('此用户没有启动播放器，或者局域网络有故障！',mterror,[mbok],0);
      result:=false;
      end;
end;


Procedure Tform1.RINI(Sender: TObject); //读取ini文件;
var T:tinifile;
begin
T:=tinifile.Create(CurrentDir+'\Ver.ini');
SoftName:=T.ReadString('VerInfo','SoftName','Error');
CurrentVer:=T.ReadString('VerInfo','CurrentVer','Error');
SoftPath:=T.ReadString('VerInfo','SoftPath','Error');
T.Free;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
memo1.Lines.SaveToFile(CurrentDir+'\TransCode.log');
close;

end;

procedure TForm1.SS1ClientRead(Sender: TObject; Socket: TCustomWinSocket);
VAR Stemp:string;
begin

sTemp:= Socket.ReceiveText;
if leftstr(stemp,5)='10001' then
begin
UPip:=copy(stemp,6,strlen(pchar(stemp)));
panel1.Caption:=UPip+' 要求更新程序,正在发送升级信息..' ;
panel1.Refresh;
Socket.SendText('11000'); //表示同意升级;
exit;
end;

if leftstr(stemp,5)='11100' then //检测当前版本信息..
begin
panel1.Caption:=UPip+' 要求更新程序,正在验证版本信息...' ;
panel1.Refresh;

  if copy(stemp,6,strlen(pchar(stemp)))<CurrentVer then
  Socket.SendText('20002'+CurrentVer)//同意升级下载.. 并且传回版本信息...
  else
  Socket.SendText('11110');//不同意升级下载..
exit;
end;


if leftstr(stemp,5)='30003' then //调用发送模块开始发送文件....
   begin
       if not ConnectTo(UPip) then
        begin
         Messagedlg('对方可能开启了防火墙和网络没有连接，连接失败！',mterror,[mbok],0);
         exit;
        end;
   timer1.Enabled:=true;
   exit;
   end;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
RINI(self);
FORM1.Caption:='※'+SoftName+'※  升级更新服务端';
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
CurrentDir:=GetCurrentDir();
memo1.Lines.clear;
if fileexists(CurrentDir+'\UpDate.log') then
memo1.Lines.LoadFromFile(CurrentDir+'\Update.log');
end;

procedure TForm1.CS1Read(Sender: TObject; Socket: TCustomWinSocket);    //发送文件；
var
  sRecv:string;
  bufSend:pointer;
  iLength:Integer;
begin
  sRecv:=Socket.ReceiveText;
  sRecv:=copy(sRecv,1,5);
 memo1.Lines.Add(sRecv);

  if sRecv=MP_REFUSE then
  Messagedlg('被拒绝!',Mterror,[mbok],0)
  else if sRecv=MP_ACCEPT then
  begin
    fsSend:=TFileStream.Create(softPath,fmOpenRead);
    bStart:=False;
    Panel1.Caption:='正在向'+UPip+'发送最新软件...';
    Panel1.Refresh ;
    TickCount:=GetTickCount;
    //iBYTEPERSEND是个常量，每次发送包的大小。
    Socket.SendText(MP_FILEPROPERTY+inttostr(Trunc(fsSend.Size/iBYTEPERSEND)+1));
    //创建文件流并发送文件长度。
  end else if sRecv=MP_NEXTWILLBEDATA then
  begin
    Socket.SendText(MP_NEXTWILLBEDATA);
    //通知接收端。继续传送数据。
  end else if sRecv=MP_DATA then
  begin
    //发送数据。

    if fsSend.Position< fsSend.Size-1 then//还有数据没有发送。
    begin
       //-----------------
       statusbar1.Panels[0].Text:=Trim(statusbar1.Panels[0].Text)+'。';
       if strlen(pchar(statusbar1.Panels[0].Text))>=40 then
       statusbar1.Panels[0].Text:='。';
       //------------------

      iLength:=fsSend.Size-fsSend.Position;
      if iLength>iBYTEPERSEND then
        iLength:=iBYTEPERSEND;
      GetMem(bufSend,iLength+1);

      try
        fsSend.Read(bufSend^,iLength);
        Socket.SendBuf(bufSend^,iLength);
      finally
        FreeMem(bufSend,iLength+1);
      end;{of try}
    end else//没有数据需要发送了。
    begin
      Socket.SendText(MP_END);//文件传送结束。
    panel1.Caption:=UPip+'最新软件发送完毕！' ;
     panel1.Refresh ;
      fsSend.Free;    //    <--------------------
       memo1.Lines.Add(datetimetostr(now)+'  用户'+UPip+'更新软件完毕，更新软件的版本:V'+CurrentVer);
      cs1.Active:=false;
      timer2.Enabled:=true;   
    end;
  end ;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
cs1.Socket.SendText(MP_QUERY+SoftPath);
timer1.Enabled:=false;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
memo1.Lines.SaveToFile(CurrentDir+'\Update.log');//更新日值
end;

procedure TForm1.Timer2Timer(Sender: TObject);
begin
panel1.Caption:='正在等待客户端升级...';
Panel1.Refresh;
memo1.Lines.SaveToFile(CurrentDir+'\Update.log');//更新日值
timer2.Enabled:=false;
statusbar1.Panels[0].Text:='';
end;

end.