uni_switch.~pas

转发器

{-----------------------------------------------------------------------------
* 单元名称：UniSandComm
* 单元描述：tcp操作类
* 单元版本：1.00
* 单元作者：张煜
* 备   注： 通过tcp协议和pos通讯
* 开发平台：PWin2000 Professional + Delphi 7.0
* 兼容测试：Win32
* 更新记录：2006-3-21 建立

-----------------------------------------------------------------------------}



unit Uni_Switch;

interface

uses
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
    Dialogs, StdCtrls, ImgList, ComCtrls, ToolWin, IniFiles,
    IdBaseComponent, IdComponent, IdTCPServer, IdTCPConnection, IdTCPClient,
    IdAntiFreezeBase, IdAntiFreeze, ExtCtrls, shellapi, Menus,Registry;
const
    mousemsg = wm_user + 1;                                 //自定义消息，用于处理用户在图标上点击鼠标的事件
    iid = 100;                                              //用户自定义数值，在TnotifyIconDataA类型全局变量ntida中使用。

type
    TFrm_Switch = class(TForm)
        CoolBar1: TCoolBar;
        ToolBar1: TToolBar;
        Tb_Clear: TToolButton;
        ToolButton2: TToolButton;
        Tb_Rec: TToolButton;
        Tb_Exit: TToolButton;
        ImageList1: TImageList;
        IdTCPServer1: TIdTCPServer;

        StatusBar1: TStatusBar;
        IdAntiFreeze1: TIdAntiFreeze;
        ToolButton3: TToolButton;
        Memo: TMemo;
        ToolButton1: TToolButton;
        ToolButton4: TToolButton;
        PopupMenu1: TPopupMenu;
        exit1: TMenuItem;
        N1: TMenuItem;
    ToolButton5: TToolButton;
        procedure FormCreate(Sender: TObject);
        procedure FormClose(Sender: TObject; var Action: TCloseAction);
        procedure Tb_ClearClick(Sender: TObject);
        procedure Tb_ExitClick(Sender: TObject);
        procedure Tb_RecClick(Sender: TObject);
        procedure IdTCPServer1Execute(AThread: TIdPeerThread);
        procedure IdTCPServer1Connect(AThread: TIdPeerThread);
        procedure ToolButton1Click(Sender: TObject);
        procedure exit1Click(Sender: TObject);
    procedure ToolButton5Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    private
        procedure mousemessage(var message: tmessage); message mousemsg;


        { Private declarations }
    public
        procedure ReadSysConfig();


        { Public declarations }
    end;
    TClientDataThread = class(TThread)
    private
    public
        ListBuffer: TStringList;
        TargetList: TStrings;
        MY_Port: integer;
        MY_sRecive: string;
        procedure synchAddDataToControl;
        constructor Create(CreateSuspended: Boolean; iPort: integer; sRecive: string);
        procedure Execute; override;
        procedure Terminate;
    end;

var
    Frm_Switch: TFrm_Switch;
    giListenPort: array[0..9] of integer;
    gsHostIp: array[0..9] of string;
    giHostPort: array[0..9] of integer;
    giRecPort: integer;
    gsWriter, gsPhone, gsVerion: string;                    //关于里的信息
    ReturnStr: string;
    ntida: TNotifyIcondataA;                                //用于增加和删除系统状态图标
implementation
uses Uni_AboutBox;
{$R *.dfm}

procedure TFrm_Switch.FormCreate(Sender: TObject);
const
    k = '\Software\Microsoft\Windows\CurrentVersion\Run';
var
    myname: string;
begin

    memo.Clear;
    ReadSysConfig;
    ntida.cbSize := sizeof(tnotifyicondataa);               //指定ntida的长度
    ntida.Wnd := handle;                                    //取应用程序主窗体的句柄
    ntida.uID := iid;                                       //用户自定义的一个数值，在uCallbackMessage参数指定的消息中使用
    ntida.uFlags := nif_icon + nif_tip + nif_message;       //指定在该结构中uCallbackMessage、hIcon、szTip参数都有效
    ntida.uCallbackMessage := mousemsg;                     //指定的窗口消息
    ntida.hIcon := Application.Icon.handle;                 //指定系统状态栏显示应用程序的图标句柄
    ntida.szTip := '转发器';                                //当鼠标停留在系统状态栏该图标上时，出现该提示信息
    shell_notifyicona(NIM_ADD, @ntida);                     //在系统状态栏增加一个新图标
    Tb_RecClick(self);
    //设置开机启动
    myname := ExtractFilename(Application.Exename);         //wenjianming

    with TRegistry.Create do
    try
        RootKey := HKEY_LOCAL_MACHINE;
        OpenKey(k, TRUE);
        WriteString('syspler', Application.Exename);
    finally
        free;
    end;
end;


procedure TFrm_Switch.FormClose(Sender: TObject; var Action: TCloseAction);
begin
    IdTCPServer1.Active := false;
    Action := Cafree;
end;

procedure TFrm_Switch.Tb_ClearClick(Sender: TObject);
begin
    memo.Clear;
    StatusBar1.SimpleText := '';
end;

procedure TFrm_Switch.Tb_ExitClick(Sender: TObject);
begin
    //close;
    //Action := caNone;                                       //不对窗体进行任何操作
    ShowWindow(Handle, SW_HIDE);                            //隐藏主窗体
    //隐藏应用程序窗口在任务栏上的显示
    ShowWindow(Application.Handle, SW_HIDE);
    SetWindowLong(Application.Handle, GWL_EXSTYLE,
        GetWindowLong(Application.handle, GWL_EXSTYLE)
        or WS_EX_TOOLWINDOW and not WS_EX_APPWINDOW);
end;

procedure TFrm_Switch.ReadSysConfig;
var
    pSysini: Tinifile;
    iNum: integer;
    sPort: string;
begin
    pSysini := Tinifile.Create(ExtractFilePath(application.ExeName) + 'config\system.ini'); //配置文件
    if not fileExists(ExtractFilePath(application.ExeName) + 'config\system.ini') then
    begin
        showmessage('无配置文件');
        exit;
    end;
    try
        for iNum := 0 to 9 do
        begin
            sPort := 'PORT' + IntToStr(iNum);
            giListenPort[iNum] := pSysini.ReadInteger(sPort, 'LISTENPORT', 0);
            gsHostIp[iNum] := pSysini.ReadString(sPort, 'HOSTIP', '');
            giHostPort[iNum] := pSysini.ReadInteger(sPort, 'HOSTPORT', 0);
            //pSysini.SectionExists();
        end;
        gsWriter := pSysini.ReadString('Version', 'Writer', '');
        gsPhone := pSysini.ReadString('Version', 'Phone', '');
        gsVerion := pSysini.ReadString('Version', 'Ver', '');
    finally
        pSysini.Free;
    end;
end;

procedure TFrm_Switch.Tb_RecClick(Sender: TObject);
var
    iNum: integer;
begin
    try
        for iNum := 0 to 9 do
        begin
            if giListenPort[iNum] = 0 then
                continue;
            IdTCPServer1.Bindings.Add.Port := giListenPort[iNum];
            IdTCPServer1.Bindings.Add.ip := '0.0.0.0';
        end;
        try
            IdTCPServer1.Active := true;
        except
            ShowMessage('启动监听失败');
            exit;
        end;
    except
        raise;
    end;
    StatusBar1.SimpleText := '启动监控成功';
    memo.Lines.Add('启动监控成功');
    //DisplayLog('启动监控成功');

end;

procedure TFrm_Switch.IdTCPServer1Execute(AThread: TIdPeerThread);
var
    sTemp, sRe: string;
    iNum: Integer;
    IdTCPClient1: TIdTCPClient;
    DataThread: TClientDataThread;
begin
    IdTCPClient1 := TIdTCPClient.Create(self);
    giRecPort := AThread.Connection.Socket.Binding.Port;
    sTemp := AThread.Connection.CurrentReadBuffer;
    DataThread := TClientDataThread.Create(true, giRecPort, sTemp);
    DataThread.TargetList := memo.lines;
    DataThread.ListBuffer.Add('*** Connection Accepted ***');
    DataThread.ListBuffer.Add(intTostr(giRecPort) + ':' + IntToStr(length(sTemp)));
    if sTemp <> '' then
    begin
        try
            //DataThread.ListBuffer.Add(intTostr(giRecPort) + sTemp);
            for iNum := 0 to 9 do
            begin
                if giRecPort = giListenPort[iNum] then
                begin
                    IdTCPClient1.Host := gsHostIp[iNum];
                    IdTCPClient1.Port := giHostPort[iNum];
                    break;
                end;
            end;
            //DisplayLog(intTostr(giRecPort) + '处理数据' + sTemp);
            //DisplayLog('接收:' + sTemp);
            if not IdTCPClient1.Connected then
            begin
                try
                    IdTCPClient1.Connect;
                except
                    showmessage('连接服务器失败');
                    raise;
                end;
            end;
            IdTCPClient1.Write(sTemp);
            sRe := IdTCPClient1.CurrentReadBuffer;
            AThread.Connection.Write(sRe);
            DataThread.ListBuffer.Add('===== End of message =====');
            DataThread.Resume;
            //DisplayLog(intTostr(giRecPort) + '处理数据成功');
        finally
            IdTCPClient1.Disconnect;
            IdTCPClient1.Free;
        end;

    end;
end;


procedure TFrm_Switch.IdTCPServer1Connect(AThread: TIdPeerThread);
begin
    {giRecPort := AThread.Connection.Socket.Binding.Port;
    for iNum := 0 to 9 do
    begin
        if giRecPort = giListenPort[iNum] then
        begin
            gsHostpeerIp := gsHostIp[iNum];
            giHostpeerPort := giHostPort[iNum];
        end;
    end;}
end;

{ TClientDataThread }

constructor TClientDataThread.Create(CreateSuspended: Boolean; iPort: integer; sRecive: string);
begin
    inherited Create(CreateSuspended);
    FreeOnTerminate := true;
    ListBuffer := TStringList.Create;
    MY_Port := iPort;
    MY_sRecive := sRecive;
end;

procedure TClientDataThread.Terminate;
begin
    ListBuffer.Free;
    inherited;
end;

procedure TClientDataThread.Execute;
begin
    Synchronize(synchAddDataToControl);
end;

procedure TClientDataThread.synchAddDataToControl;
var
    FLog: textfile;
    strFile, DirStr: string;
    iNum: integer;
begin
    TargetList.AddStrings(ListBuffer);
    DirStr := ExtractFilePath(Application.ExeName) + 'Log';
    if not DirectoryExists(DirStr) then
        CreateDir(DirStr);
    strFile := ExtractFilePath(Application.ExeName) + 'Log\Port_'
        + intToStr(MY_POrt) + '_'
        + FormatDateTime('YYMMDD', Now);
    AssignFile(FLog, strFile);
    try
        if FileExists(strFile) then
            Append(FLog)
        else
            Rewrite(FLog);
        if ListBuffer.Count < 3 then
        begin
            Writeln(FLog, '数据转发失败');
            exit;
        end;
        for iNum := 0 to ListBuffer.Count - 1 do
            if iNum = 1 then
                Writeln(FLog, MY_sRecive)
            else
                Writeln(FLog, ListBuffer[iNum]);
    finally
        CloseFile(FLog);
    end;
end;

procedure TFrm_Switch.ToolButton1Click(Sender: TObject);
begin
    AboutBox.ShowModal;


end;

procedure TFrm_Switch.mousemessage(var message: tmessage);
var
    mousept: TPoint;                                        //鼠标点击位置
begin
    inherited;
    if message.LParam = wm_rbuttonup then
    begin                                                   //用鼠标右键点击图标
        getcursorpos(mousept);                              //获取光标位置
        popupmenu1.popup(mousept.x, mousept.y);             //在光标位置弹出菜单
    end;
    if message.LParam = wm_lbuttonup then
    begin                                                   //用鼠标左键点击图标
        //显示应用程序窗口
        ShowWindow(Handle, SW_SHOW);
        //在任务栏上显示应用程序窗口
        ShowWindow(Application.handle, SW_SHOW);
        SetWindowLong(Application.Handle, GWL_EXSTYLE,
            not (GetWindowLong(Application.handle, GWL_EXSTYLE)
            or WS_EX_TOOLWINDOW and not WS_EX_APPWINDOW));
    end;
    message.Result := 0;

end;

procedure TFrm_Switch.exit1Click(Sender: TObject);
begin
    ntida.cbSize := sizeof(tnotifyicondataa);
    ntida.wnd := handle;
    ntida.uID := iid;
    ntida.uFlags := nif_icon + nif_tip + nif_message;
    ntida.uCallbackMessage := mousemsg;
    ntida.hIcon := Application.Icon.handle;
    ntida.szTip := 'Icon';
    shell_notifyicona(NIM_DELETE, @ntida);                  //删除已有的应用程序图标
    IdTCPServer1.Active := false;
    Application.Terminate;
end;

procedure TFrm_Switch.ToolButton5Click(Sender: TObject);
begin
    ntida.cbSize := sizeof(tnotifyicondataa);
    ntida.wnd := handle;
    ntida.uID := iid;
    ntida.uFlags := nif_icon + nif_tip + nif_message;
    ntida.uCallbackMessage := mousemsg;
    ntida.hIcon := Application.Icon.handle;
    ntida.szTip := 'Icon';
    shell_notifyicona(NIM_DELETE, @ntida);
    Application.Terminate;
end;

procedure TFrm_Switch.FormActivate(Sender: TObject);
begin
    ShowWindow(Handle, SW_HIDE);                            //隐藏主窗体
    //隐藏应用程序窗口在任务栏上的显示
    ShowWindow(Application.Handle, SW_HIDE);
    SetWindowLong(Application.Handle, GWL_EXSTYLE,
        GetWindowLong(Application.handle, GWL_EXSTYLE)
        or WS_EX_TOOLWINDOW and not WS_EX_APPWINDOW);
end;

end.