main.pas

用在局域网中完成机子之间的数据传递

unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Mask, ToolEdit, ExtCtrls, Buttons, NMSTRM, Psock,
  ComCtrls, Menus, NMUDP, WinSock, ShellAPI, ToolWin, RXShell, AppEvnts,
  XPMenu, Gauges;

type
  TfrmMain = class(TForm)
    PPMemu: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    PanelRight: TPanel;
    Panel1: TPanel;
    SendTo: TComboEdit;
    Label2: TLabel;
    Label1: TLabel;
    FileName: TFilenameEdit;
    SaveDialog: TSaveDialog;
    Strm: TNMStrm;
    StrmServ: TNMStrmServ;
    NMUDP: TNMUDP;
    Panel2: TPanel;
    BtnSend: TSpeedButton;
    SBAbout: TSpeedButton;
    ListBox: TListBox;
    TrayIcon: TRxTrayIcon;
    ApplicationEvents1: TApplicationEvents;
    XPMenu1: TXPMenu;
    N3: TMenuItem;
    Gauge: TGauge;
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure SBAboutClick(Sender: TObject);
    procedure StrmConnect(Sender: TObject);
    procedure StrmDisconnect(Sender: TObject);
    procedure StrmConnectionFailed(Sender: TObject);
    procedure StrmInvalidHost(var Handled: Boolean);
    procedure StrmStatus(Sender: TComponent; Status: String);
    procedure StrmHostResolved(Sender: TComponent);
    procedure StrmServClientContact(Sender: TObject);
    procedure StrmServMSG(Sender: TComponent; const sFrom: String;
      strm: TStream);
    procedure StrmServDisconnect(Sender: TObject);
    procedure BtnSendClick(Sender: TObject);
    procedure NMUDPDataSend(Sender: TObject);
    procedure NMUDPDataReceived(Sender: TComponent; NumberBytes: Integer;
      FromIP: String; Port: Integer);
    procedure StrmServInvalidHost(var Handled: Boolean);
    procedure StrmPacketRecvd(Sender: TObject);
    procedure StrmPacketSent(Sender: TObject);
    procedure SendToButtonClick(Sender: TObject);
    procedure TrayIconDblClick(Sender: TObject);
    procedure ApplicationEvents1Minimize(Sender: TObject);
    procedure ApplicationEvents1Restore(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    procedure ErrorBox(Str:String);
    { Private declarations }
  public
    procedure ReturnUDPTransQry(var Msg:String;Const FromIP:String);
    procedure ReReturnUDPTransQry(Const Msg,FromIP:String);
    procedure TransMyInfo(Var Msg:String;Const FromIP:String);
    procedure ReceiveInfo(Const IP,CName:String);

    { Public declarations }
  end;

var
  frmMain: TfrmMain;
  SingleFileName:String;

implementation

uses NetUnit, IPList, About;
{$R *.dfm}

procedure TfrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  If Application.MessageBox('您确认退出程序吗？','提示',MB_YESNO+MB_ICONINFORMATION)= IDYes
  then CanClose:=True
  else CanClose:=False;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  LocalIP:=GetLocalIP;
  LocalCName:=GetLocalCName;
  SetBroadCastIP;
  Caption:=Application.Title;
  Caption:=Caption+' '+LocalIP;
  TrayIcon.Icon:=Application.Icon;
  MsgStream:=TMemoryStream.Create;
end;

procedure TfrmMain.SBAboutClick(Sender: TObject);
begin
  frmAbout.Showmodal;
end;

procedure TfrmMain.ErrorBox(Str: String);
begin
  Application.MessageBox(PChar(Str),'错误',MB_OK+MB_ICONerror);
end;


//=============================================================一般过程显示

procedure TfrmMain.StrmConnect(Sender: TObject);
begin
  ListBox.Items.Add(FormatDateTime('HH:MM:SS',Time())+'>Strm Connect');
end;

procedure TfrmMain.StrmDisconnect(Sender: TObject);
begin
  ListBox.Items.Add(FormatDateTime('HH:MM:SS',Time())+'>Strm Disconnected');
end;

procedure TfrmMain.StrmConnectionFailed(Sender: TObject);
begin
  ListBox.Items.Add(FormatDateTime('HH:MM:SS',Time())+'>Strm Connection Failed');
  ErrorBox('$连接失败!');
end;

procedure TfrmMain.StrmInvalidHost(var Handled: Boolean);
begin
  ListBox.Items.Add(FormatDateTime('HH:MM:SS',Time())+'>Strm Invalid Host');
  ErrorBox('$无效的主机地址:  '+SendTo.Text+' !');
end;

procedure TfrmMain.StrmStatus(Sender: TComponent; Status: String);
begin
  ListBox.Items.Add(FormatDateTime('HH:MM:SS',Time())+'>Strm Status : '+Status);
end;

procedure TfrmMain.StrmHostResolved(Sender: TComponent);
begin
  ListBox.Items.Add(FormatDateTime('HH:MM:SS',Time())+'>Strm Host Resolved');
end;

procedure TfrmMain.StrmServDisconnect(Sender: TObject);
begin
  ListBox.Items.Add(FormatDateTime('HH:MM:SS',Time())+'>StrmServer Disconnected');
end;

procedure TfrmMain.StrmServClientContact(Sender: TObject);
begin
  ListBox.Items.Add(FormatDateTime('HH:MM:SS',Time())+'>StrmServer Client Contact');
end;

procedure TfrmMain.NMUDPDataSend(Sender: TObject);
begin
  ListBox.Items.Add(FormatDateTime('HH:MM:SS',Time())+'>NMUDP Data Send');
end;

procedure TfrmMain.StrmServInvalidHost(var Handled: Boolean);
begin
  ListBox.Items.Add(FormatDateTime('HH:MM:SS',Time())+'>StrmServer Invalid Host');
  ErrorBox('$无效的主机地址');
end;





//==================================================================
//  开始执行
//==================================================================




procedure TfrmMain.BtnSendClick(Sender: TObject);
var
  Msg:String;
begin
  if (FileName.FileName='') or (SendTo.Text='') then ErrorBox('文件名或IP地址无效！')
  else
    begin
    Msg:=FileName.FileName;
    IniMsgStream;
    try
      MsgStream.Write(Msg[1],Length(Msg));
      NMUDP.RemoteHost:=SendTo.Text;
      NMUDP.SendStream(MsgStream);
      BtnSend.Enabled:=False;
    Except
      ErrorBox('对方可能没有打开程序，运行错误！'#13+'或与制作人联系');
      IniMsgStream;
    end;
    end;
end;

procedure TfrmMain.NMUDPDataReceived(Sender: TComponent;
  NumberBytes: Integer; FromIP: String; Port: Integer);
Var
  Msg:String;
begin
  IniMsgStream;
  NMUDP.ReadStream(MsgStream);
  SetLength(Msg,NumberBytes);
  MsgStream.Read(Msg[1],NumberBytes);
  if Copy(Msg,1,3)='@_0' then TransMyInfo(Msg,FromIP) else
  if Copy(Msg,1,3)='@_1' then ReceiveInfo(Copy(Msg,4,15),Copy(Msg,19,Length(Msg)-18)) else
  if Copy(Msg,1,2)='#_'  then ReReturnUDPTransQry(Msg,FromIP) else
                              ReturnUDPTransQry(Msg,FromIP);
end;

procedure TfrmMain.StrmServMSG(Sender: TComponent; const sFrom: String;
  strm: TStream);
var
  MyFStream:TFileStream;
begin
  SaveDiaLog.FileName:=SingleFileName;
  if SaveDialog.Execute then
     begin
     MyFStream := TFileStream.Create(SaveDialog.InitialDir+SingleFileName,fmCreate);
     end
  else ErrorBox('存入文件名无效！！！');
  try
    MyFStream.CopyFrom(strm, strm.size);
    Application.MessageBox('接收文件成功！','成功',MB_OK+MB_ICONINFORMATION);
    FileName.Clear;
    SendTo.Clear;
    Gauge.Progress:=0;
    Panel1.Enabled:=True;
  finally
    MYFStream.Free;
  end;
end;

procedure TfrmMain.ReReturnUDPTransQry(const Msg,FromIP: String);
var
  MyFStream:TFileStream;
begin
if Copy(Msg,1,3)='#_1' then
   begin
   Application.MessageBox(PCHAR('用户 '+FromIP+' 同意接收文件！'),'响应',MB_OK+MB_ICONINFORMATION);
   Strm.Host:=SendTo.Text;
   MyFStream:= TFileStream.Create(FileName.FileName , fmOpenRead);
   try
     Strm.PostIt(MyFStream);
     Application.MessageBox(PCHAR('向用户 '+FromIP+' 传送文件成功！'),'结果',MB_OK+MB_ICONINFORMATION);
     Gauge.Progress:=0;
     BtnSend.Enabled:=True;
   finally
     MyFStream.Free;
   end;
end
   else
   begin
     Application.MessageBox(PCHAR('用户 '+FromIP+' 不同意接收文件！'),'响应',MB_OK+MB_ICONWarning);
     BtnSend.Enabled:=True;
   end;
end;

procedure TfrmMain.ReturnUDPTransQry(var Msg:String;Const FromIP:String);
begin
  if Application.MessageBox(PCHAR('用户 '+FromIP+' 欲向您传送一文件，相关内容如下：'#13#13+
     Msg+#13#13'请问是否同意接收？'),'接收到传送文件信息',MB_YESNO+MB_ICONQUESTION) = IDYes
  then
       begin
       SingleFileName:=ExtractFileName(Msg);
       Msg:='#_1';
       IniMsgStream;
       MsgStream.Write(Msg[1],Length(Msg));
       NMUDP.RemoteHost:=FromIP;
       NMUDP.SendStream(MsgStream);
       end
  else begin
       SingleFileName:='';
       Msg:='#_0';
       IniMsgStream;
       MsgStream.Write(Msg[1],Length(Msg));
       NMUDP.RemoteHost:=FromIP;
       NMUDP.SendStream(MsgStream);
       end;
end;

procedure TfrmMain.StrmPacketRecvd(Sender: TObject);
begin
  Gauge.MaxValue:=Strm.BytesTotal;
  Gauge.Progress:=Strm.BytesSent;
end;

procedure TfrmMain.StrmPacketSent(Sender: TObject);
begin
  Panel1.Enabled:=False;
  Gauge.MaxValue:=Strm.BytesTotal;
  Gauge.Progress:=Strm.BytesSent;
end;

procedure TfrmMain.SendToButtonClick(Sender: TObject);
begin
  frmIPList.ShowModal;
end;

procedure TfrmMain.TransMyInfo(Var Msg:String;Const FromIP:String);
var
  NNStream:TMemoryStream;
begin
  NNStream:=TMemoryStream.Create;
  msg:='@_1';
  msg:=msg+Trim(Format('%-15s%-255s',[LocalIP,LocalCName]));
  NNStream.Write(Msg[1],Length(Msg));
  NMUDP.RemoteHost:=FromIP;
  NMUDP.SendStream(NNStream);
end;

procedure TfrmMain.ReceiveInfo(Const IP,CName:String);
var O:TListItem;
begin
  O:=frmIPList.List.Items.Add;
  O.Caption:=Trim(CName);
  O.SubItems.Add(Trim(IP));
end;

procedure TfrmMain.TrayIconDblClick(Sender: TObject);
begin
  Application.Restore;
  Application.BringToFront;
end;

procedure TfrmMain.ApplicationEvents1Minimize(Sender: TObject);
begin
  ShowWindow(Application.Handle,SW_HIDE);
end;

procedure TfrmMain.ApplicationEvents1Restore(Sender: TObject);
begin
  ShowWindow(Application.Handle,SW_SHOW);
end;

procedure TfrmMain.N2Click(Sender: TObject);
begin
  Close;
end;

procedure TfrmMain.FormShow(Sender: TObject);
begin
  frmIPList.OnShow(Nil);
end;

end.