main.~pas

求是科技出版的《Delphi串口通信工程开发实例导航》所有的源代码。是一本很好的书。拿出来与大家共享。

procedure TfrmMain.UpdateEmailList(lst : TList);
begin
        frmRight.frmTop.lsvEmail.Clear();
        frmRight.frmTop.AddToMailList(lst);
end;

//
// 定时检测事件
//
procedure TfrmMain.TimCheckTimer(Sender: TObject);
begin
        TimCheck.Enabled := False;
        TimShow.Enabled := False;
        StartCheckMail();
        m_CheckTime := Time;
        TimCheck.Enabled := True;
        if Account.m_lstAccount = nil then
                exit;
        if Account.m_lstAccount.Count = 0 then
                exit;
        TimShow.Enabled := True;
end;

//
// 刷新当前时间
//
procedure TfrmMain.TimShowTimer(Sender: TObject);
var
        LastTime : TTime;

begin
        if Config.m_Config.m_Interval < 1 then
                Config.m_Config.m_Interval := 1;
        LastTime := timCheck.Interval / (1000 * 3660 * 24) + m_CheckTime - Time;
        if LastTime < 30 / (60 * 60 * 24) then
                frmRight.frmBottom.labLastTime.Font.Color := clRed
        else
                frmRight.frmBottom.labLastTime.Font.Color := clBlack;

        frmRight.frmBottom.labLastTime.Caption := '剩余时间:' + TimeToStr(LastTime);
end;

procedure TfrmMain.tbtnAccountClick(Sender: TObject);
begin
        MnAccountClick(Sender);
end;

procedure TfrmMain.tbtnConfigClick(Sender: TObject);
begin
        MnConfigClick(Sender);
end;

procedure TfrmMain.tbtnStopClick(Sender: TObject);
begin
        m_IsStop := True;
end;

procedure TfrmMain.tbtnExitClick(Sender: TObject);
begin
        MnExitClick(Sender);
end;

procedure TfrmMain.MnExitClick(Sender: TObject);
begin
        Application.Terminate();
end;

//
// 自定义消息, 表示数据读取完毕，
// 注意project中，frmAccount, frmConfig两个顺取不能更改
//
procedure TfrmMain.IniFinished(var Msg: TMessage);
var
        pAccount : ^TAccountInfo;
begin
        //
        // 要先更新上部视图，然后再更新左视图
        //
        UpdateTopView();
        UpdateLeftView();
        //
        // 更新邮件列表
        //
        if Account.m_lstAccount = nil then
                exit;

        pAccount := Account.m_lstAccount.Items[frmRight.frmTop.tabAccount.TabIndex];
        UpdateEmailList(pAccount^.m_lstEmail);
        //
        // 程序启动时马上开始检测邮件
        //
        TimCheck.OnTimer(self);
end;

//
// 托盘图标响应事件
//
procedure TfrmMain.OnNotify(var Msg: TMessage);
var
        pos : TPoint;
begin
        case Msg.LParam of
                WM_LBUTTONDBLCLK:   // 双击事件
                begin
                        frmMain.Visible := True ;
                        Shell_NotifyIcon(NIM_DELETE,@NotifyIcon);
                        Application.Restore();
                        SetForegroundWindow(frmMain.Handle);
                end;
                WM_RBUTTONUP:       // 右键点击
                begin
                        GetCursorPos(pos);
                        frmMain.PopupMenu1.Popup(pos.X, pos.Y);
                end;
        End;
end;

procedure TfrmMain.tbtnScheduleClick(Sender: TObject);

begin
        MnScheduleClick(Sender);
end;


procedure TfrmMain.FormDestroy(Sender: TObject);
begin
        Shell_NotifyIcon(NIM_DELETE,@NotifyIcon);
end;

//
// 应用程序最小化时调用此函数
//
procedure TfrmMain.OnAppMinimize(Sender: TObject);
begin
        if Config.m_Config.m_Hide then
        begin
                frmMain.Visible := False;
                //
                // 把设置好的变量NotifyIcon加入到系统中以便处理
                //
                Shell_NotifyIcon(NIM_ADD,@NotifyIcon);
        end;
end;

procedure TfrmMain.ppMAccountClick(Sender: TObject);
begin
        MnAccountClick(Sender);
end;

procedure TfrmMain.ppMConfigClick(Sender: TObject);
begin
        MnConfigClick(Sender);
end;

procedure TfrmMain.ppMCheckClick(Sender: TObject);
begin
        MnCheckClick(Sender);
end;

procedure TfrmMain.ppMStopClick(Sender: TObject);
begin
        MnStopClick(Sender);
end;

procedure TfrmMain.MnStopClick(Sender: TObject);
begin
        m_IsStop := True;
end;

procedure TfrmMain.MnScheduleClick(Sender: TObject);
begin
        Config.m_Config.m_Hide := True;
        Application.Minimize();
end;

procedure TfrmMain.ppMRestoreClick(Sender: TObject);
var
        msg : TMessage;
begin
        msg.LParam := WM_LBUTTONDBLCLK;
        OnNotify(msg);
end;

procedure TfrmMain.ppMExitClick(Sender: TObject);
begin
        MnExitClick(Sender);
end;

//
// 打开串口
//
function TfrmMain.OpenPort: Boolean;
begin
         //
        // 更新MSComm的设置
        //
        try
                MSComm.CommPort := Config.m_Com.m_ComPort;
                MSComm.Settings := Config.m_Com.m_BaudRate + ',' + Copy(Config.m_Com.m_Parity, 0, 1) + ',' + Config.m_Com.m_DataBits + Config.m_Com.m_StopBits;
                MSComm.InBufferSize := 1024;            // 指定接收缓冲区大小
                MSComm.InBufferCount := 0;              // 清空接收缓冲区
                MSComm.InputMode := 1;                  // 设置数据获取方式
                MSComm.InputLen := 0;                   // 设置读取方式
                MSComm.PortOpen := True;                // 打开指定的串口

                OpenPort := MSComm.PortOpen;            // 反回值
        except
                OpenPort := False;
                MessageBox(self.Handle, PChar('串口' + PChar(IntToStr(Mscomm.CommPort)) + '打开失败!,请更换其它串口'),'串口打开失败',MB_OK);
        end;
end;


//
// 初始化短信息设置
//
procedure TfrmMain.IniSMS;
var
        SendData : string;
begin
        //
        // 先判断串口是否打开
        //
        if not MSComm.PortOpen then
                exit;
        //
        // 设置编码模式，其中Text=1, pdu = 0
        //
        if Config.m_Config.m_SMSMode = 'Text' then
                SendData := 'AT+CMGF=1' + chr(13)  // Text
        else
                SendData := 'AT+CMGF=0' + chr(13); // Pdu
        MSComm.Output := SendData;
        //
        // 设置短信中心号码
        //
        SendData := 'AT+CSCA="' + Config.m_Config.m_SMSCenter + '"' + chr(13);
        MSComm.Output := SendData;
end;

//
// Text模式编码
//
procedure TfrmMain.SendInEncodeText(sms, mobile: string);
var
        strOut : string;        // 定义成string型，一个字符用一个字节来表示
begin
        strOut := 'AT+CMGS="' + mobile + '"' + chr(13);  // chr(13)是回车
        MSComm.Output := strOut;
        strOut := sms + chr(26);        // chr(26) 是 ctrl + z
        MSComm.Output := strOut;
end;


//
// Pdu模式编码
//
procedure TfrmMain.SendInEncodePdu(sms, mobile: string);
var
        Widesms : WideString;  // 定义成WideString型，每个字符占两上字节
        SendData : string;
        tmp : string;
        len : integer;
begin
        //
        // 参考pdu串   08 91 683108701305F0 11 00 0B 91 3176378290F9 00 00 00 02 C834
        //
        SendData := 'AT+CMGS="';
        SendData := SendData + '0891';
        //
        // 每两位交换构造短信中心串
        //
        tmp := ExchangeCode(Config.m_Config.m_SMSCenter);
        SendData := SendData + tmp;
        SendData := SendData + '11000B91';
        //
        // 每两位交换构造接收手机号码串
        //
        tmp := ExchangeCode(mobile);
        SendData := SendData + tmp;
        SendData := Senddata + '0000A7';
        //
        // 将中文GB2312编码转换为代码页为CP936的Unicode编码
        //
        Widesms := WideString(sms);
        tmp := EncodeGb(Widesms);
        //
        // 此处为Widesms 的长度，不是sms的长度！
        //
        len := length(Widesms);
        SendData := SendData + IntToStr(len) + tmp;
        SendData := SendData + '"' + chr(13);
        //
        // Pdu串构造完毕，发送
        //
        MSComm.Output := SendData;
end;

//
// 将中文GB2312编码转换为代码页为CP936的Unicode编码
//
function TfrmMain.EncodeGb(var s: WideString): String;
var
        i,len:Integer;
        cur:Integer;
        t:String;
begin
        Result:='';
        len:=Length(s);
        i:=1;
        while i<=len do
        begin
                cur:=ord(s[i]);
                //BCD转换
                FmtStr(t,'%4.4X',[cur]);
                Result:=Result+t;
                inc(i);
        end;
end;

//
// 用来交换移位
//
function TfrmMain.ExchangeCode(src: string): string;
var
        Len, i : integer;
        tmp : string;
begin
        Len := length(src);
        if (len <> 11) and (len <> 13) then
        begin
                ExchangeCode := '';
                exit;
        end;
        src := src + 'F';

        i := 1;
        while i<=len do
        begin
                tmp := tmp + src[i + 1] + src[i];
                inc(i, 2);
        end;
        ExchangeCode := tmp;
end;

end.