userver.pas

如何在Delphi下实现画面捕捉、传输、以及文件的传输原理

unit UServer;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Sockets, ComCtrls, IdBaseComponent, IdComponent,
  IdTCPServer, DB, ADODB, Grids, DBGrids, IdThreadMgr, IdThreadMgrDefault,ShellAPI;

Const MY_MESSAGE = WM_USER + 100;

type

  TCommBlock = record
  	StrKind,
        SendName,
        ToName,
        Msg : String[100];
  end;

type
  PClient   = ^TClient;
  TClient   = record  // Object holding data of client (see events)
                QQ         : String[20];            { QQ for identify the host }
                Thread      : Pointer;               { Pointer to thread }
  end;

  TFmServer = class(TForm)
    MemRecv: TMemo;
    StatusBar: TStatusBar;
    IdTCPServer: TIdTCPServer;
    ADOConnection: TADOConnection;
    ADOQuery: TADOQuery;
    DataSource1: TDataSource;
    IdThreadMgrDefault1: TIdThreadMgrDefault;
    procedure IdTCPServerConnect(AThread: TIdPeerThread);
    procedure IdTCPServerDisconnect(AThread: TIdPeerThread);
    procedure IdTCPServerExecute(AThread: TIdPeerThread);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormPaint(Sender: TObject);
  private
    { Private declarations }
    Procedure OnIconNotify(var Message: TMessage);
    Message MY_MESSAGE;
  public
    { Public declarations }
  end;


var
  FmServer: TFmServer;
  Clients : TThreadList;     // Holds the data of all clients

implementation

{$R *.dfm}


procedure TFmServer.IdTCPServerConnect(AThread: TIdPeerThread);
begin
	AThread.Data := TObject(AThread.Connection.LocalName);
        StatusBar.Panels[0].Text := TimeToStr(Time) + '来自计算机"' + AThread.Connection.LocalName + '"的呼叫！';
        
end;

procedure TFmServer.IdTCPServerDisconnect(AThread: TIdPeerThread);
var
  	ActClient: PClient;
begin
	StatusBar.Panels[0].Text := TimeToStr(Time) + '计算机"' + AThread.Connection.LocalName + '"断开连接！';

  	ActClient := PClient(AThread.Data);
  	try
    		Clients.LockList.Remove(ActClient);
        finally
    		Clients.UnlockList;
  	end;

        FreeMem(ActClient);
        AThread.Data := nil;
end;

procedure TFmServer.IdTCPServerExecute(AThread: TIdPeerThread);
var
	NewCommBlock,CommBlock : TCommBlock;
        RecClient,NewClient: PClient;
        RecThread : TIdPeerThread;
        I : Integer;
begin
	if not AThread.Terminated and AThread.Connection.Connected then
        begin
        	AThread.Connection.ReadBuffer(CommBlock,Sizeof(CommBlock));

                if CommBlock.StrKind = 'LOGIN' then
                begin
                         NewCommBlock := CommBlock;//all the change is done in the new object
                         MemRecv.Lines.Add(TimeToStr(Time) + ': ' + NewCommBlock.SendName + '来访');

                         with ADOQuery do
                         begin
                         	close;
                                SQL.Clear;
                                SQL.Add('select Key from Users_Info where QQ=:qq');
                                Parameters[0].Value := NewCommBlock.SendName;
                                open;
                                if FieldByName('Key').AsString = NewCommBlock.Msg then
                                begin
                                        NewCommBlock.StrKind := 'LOGIN'; //login ok!
                                        NewCommBlock.Msg := 'R';

                                        GetMem(NewClient, SizeOf(TClient));
                                        NewClient.QQ     := NewCommBlock.SendName;
                                        NewClient.Thread := AThread;//binding the thread by the qq number

					AThread.Data := TObject(NewClient);
                                        try
                                            	Clients.LockList.Add(NewClient);
                                        finally
                                        	Clients.UnlockList;
                                        end;

                                end
                                else
                                begin
                                    	NewCommBlock.StrKind := 'LOGIN';//the key or qq is wrong;
                                        NewCommBlock.Msg := 'W';
                                end;
                         end;
                         AThread.Connection.WriteBuffer(NewCommBlock,Sizeof(NewCommBlock),True);
                end
                else
                if CommBlock.StrKind = 'SENDMSG' then
                begin
                        //I := 0;
                        NewCommBlock := CommBlock;
                        NewCommBlock.StrKind := 'SENDMSG';
                        NewCommBlock.Msg := NewCommBlock.Msg ;

                        with Clients.LockList do
                        begin
                                try
                                        for I := 0 to Count -1 do
                        		begin
                                                RecClient := Items[I];
                                        	if RecClient.QQ = NewCommBlock.ToName then
                                                //select the appripiate thread object from the Threadlist by the qq number
                                		begin
                                                        RecThread := RecClient.Thread;
                                                        RecThread.Connection.WriteBuffer(NewCommBlock,SizeOf(NewCommBlock),True);
                                		end;
                                        end;
                                finally
                                	Clients.UnlockList;
                                end;
                        end;
                end
                else
                if CommBlock.StrKind = 'FRDLIST' then
                begin
                        I := 0;
                        NewCommBlock := CommBlock;

                        with ADOQuery do
                        begin
				Close;
                                SQL.Clear;
                                SQL.Add('select FriendQQ from FriendList where UserQQ=:qq');
                                Parameters[0].Value := NewCommBlock.SendName;
                                Open;
                                NewCommBlock.Msg := FieldByName('FriendQQ').AsString;
                                Next;
                                I := I + 1;
                                while I < RecordCount do
                                begin
                                    	NewCommBlock.Msg := NewCommBlock.Msg + '/' + FieldByName('FriendQQ').AsString;
                                        Next;
                                        I := I + 1;
                                end;//获取这个qq号的好友列表,中间以‘/’为间隔！

                                NewCommBlock.Msg := NewCommBlock.Msg + '/';
                        end;

                        NewCommBlock.StrKind := 'FRDLIST';
                	AThread.Connection.WriteBuffer(NewCommBlock,SizeOf(NewCommBlock),True);
                end;
                {else
                if CommBlock.StrKind = 'CLOSED' then
                begin

                        try
                		with Clients.LockList do
                        	begin
                            		for I := 0 to Count - 1 do
                                	begin
                            			ActClient := Items[I];
                                                if ActClient.QQ = CommBlock.SendName then
                                                begin
                                                    	Remove( ActClient );
                                                end;
                                	end;
                        	end;
                        finally
                        	Clients.UnlockList;
                        end;
                end;}
        end;
end;

procedure TFmServer.FormCreate(Sender: TObject);
var
	Nid : TNotifyIconData;
begin
	IdTcpServer.DefaultPort := 8080;
        IdTcpServer.Active := True;//set the server is available

        Clients := TThreadList.Create;

	ADOConnection.ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;Password="";Data Source=DB\dbdemo.mdb;Persist Security Info=True';
        ADOQuery.Active := True;//set the database is available

        //以下是建立托盘程序所用
        {当主Form建立时通知Windows加入小图标}
	Nid.cbSize := SizeOf(Nid);//Nid Size
        Nid.Wnd := Handle;//the handle of the main form
        Nid.uID := 1;
        Nid.hIcon := Application.Icon.Handle;
        Nid.szTip := 'the server is active';
        Nid.uCallbackMessage := MY_MESSAGE;//callbake message
        Nid.uFlags := NIF_ICON or NIF_TIP or NIF_MESSAGE;//identify the effective record

        if not Shell_NotifyIcon(NIM_ADD,@Nid) then
        begin
        	Showmessage('failed!');
                Application.Terminate;
        end;
        //将程序的窗口样式设为TOOL窗口，可避免在任务条上出现
        SetWindowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW);
end;

procedure TFmServer.FormClose(Sender: TObject; var Action: TCloseAction);
var
	Nid : TNotifyIconData;
begin
	Nid.cbSize := SizeOf(nid);
        Nid.uID := 1;
        Nid.Wnd := Handle;
        Shell_NotifyIcon(NIM_DELETE, @Nid);
end;

procedure TFmServer.FormPaint(Sender: TObject);
begin
	Hide;
end;

procedure TFmServer.OnIconNotify(var Message: TMessage);
var
	Busy : Boolean;
begin
        Busy := False;
        if not Busy then
        begin
            	Busy := True;

                if Message.LParam = WM_LBUTTONDOWN then
                begin
                    	if Application.MessageBox('Are you sure','Exit',MB_YESNO) = IDYES then
                        	Close;
                end;
                Busy := False;
        end;
end;

end.