untcomm.pas

phonectrl是一款利用手机遥控电脑的软件

{-------------------------------------------------------------------------------
  过程名:    SendInitCodeToComPort
  作者:      小冬[kendling]
  邮件:      [e-mail]
  主页:      http://www.MyvNet.com
  日期:      2005.02.01
  参数:      无
  返回值:    无
  说明:      发送手机遥控器初始化代码
-------------------------------------------------------------------------------}
procedure SendInitCodeToComPort;
begin
  //静音
  if bConnInMute then
    SendCmdToComPort('AT*ESIL=1');

  //支持中文
  if bUtf8 then
    SendCmdToComPort('AT+CSCS="UTF-8"');

  //主菜单
  SendCmdToComPort('AT*EAM="我的控制菜单"');
end;
                                  
{-------------------------------------------------------------------------------
  过程名:    SendResetCodeToComPort
  作者:      小冬[kendling]
  邮件:      [e-mail]
  主页:      http://www.MyvNet.com
  日期:      2005.02.07
  参数:      无
  返回值:    无
  说明:      发送复位命令到端口
-------------------------------------------------------------------------------}
procedure SendResetCodeToComPort;
begin
  SendCmdToComPort('AT+CMER=0,0,0,0,0');
  SendCmdToComPort('AT+CSCS=' + pCSCS);
  SendCmdToComPort('AT*ESIL=' + BoolToStr(pMute));
end;

{-------------------------------------------------------------------------------
  过程名:    SendCmdToComPort
  作者:      小冬[kendling]
  邮件:      [e-mail]
  主页:      http://www.MyvNet.com
  日期:      2005.02.01
  参数:      Cmd: string
  返回值:    Word
             0   - 出错
             1   - 成功
  说明:      发送手机控制命令
-------------------------------------------------------------------------------}
procedure SendCmdToComPort(const Cmd: string);
var
  tmpUTF8String: UTF8String;
begin
//  Result := 0;
  tmpUTF8String := AnsiToUtf8(Cmd+#13#10);
//  FMain.mmo1.Lines.Add(Utf8ToAnsi(tmpUTF8String));
//  if objComPort.GetModemState=48 then
//  begin
  if bUtf8 then
    objComPort.WriteCommData(PChar(tmpUTF8String),Length(tmpUTF8String))
  else
    objComPort.WriteCommData(PChar(Cmd + #13#10),Length(Cmd + #13#10));
    Sleep(300);
//    Result := 1;
//  end;
end;

{-------------------------------------------------------------------------------
  过程名:    CaptureKey
  作者:      小冬[kendling]
  邮件:      [e-mail]
  主页:      http://www.MyvNet.com
  日期:      2005.02.21
  参数:      const Capture: Boolean
  返回值:    无
  说明:      捕获手机键盘
-------------------------------------------------------------------------------}
procedure CaptureKey(const Capture: Boolean);
begin
  if Capture then
    SendCmdToComPort('AT+CMER=3,2,0,0,0')
  else
    SendCmdToComPort('AT+CMER=0,0,0,0,0');
end;

{-------------------------------------------------------------------------------
  过程名:    SendInfoToPhone
  作者:      小冬[kendling]
  邮件:      [e-mail]
  主页:      http://www.MyvNet.com
  日期:      2005.02.26
  参数:      const strMessage: string
  返回值:    无
  说明:      在手机上显示提示信息
-------------------------------------------------------------------------------}
procedure SendInfoToPhone(const strMessage: string; const iSec: Byte = 0);
var
  strCmd: string;
begin
  if iSec <= 0 then
  begin
    strCmd := 'AT*EAID=1,0,"' + strMessage + '"';
  end
  else begin
    strCmd := 'AT*EAID=1,2,"' + strMessage + '",' + IntToStr(iSec);
  end;
  SendCmdToComPort(strCmd);
end;

{-------------------------------------------------------------------------------
  过程名:    ShowMainMenu
  作者:      小冬[kendling]
  邮件:      [e-mail]
  主页:      http://www.MyvNet.com
  日期:      2005.02.18
  参数:      无
  返回值:    无
  说明:      显示主菜单
-------------------------------------------------------------------------------}
procedure ShowMainMenu;
var
  strCmd: string;
begin
  strCmd := 'AT*EASM="' + strMainMenu + '",1,1,4';
  strCmd := strCmd + ',"' + strMainMenu1 + '"'; 
  strCmd := strCmd + ',"' + strMainMenu2 + '"';
  strCmd := strCmd + ',"' + strMainMenu3 + '"';
  strCmd := strCmd + ',"' + strMainMenu4 + '"';
  SendCmdToComPort(strCmd);
  SelectMenu := pmsMain;
end;

{-------------------------------------------------------------------------------
  过程名:    ShowApplicationMenu
  作者:      小冬[kendling]
  邮件:      [e-mail]
  主页:      http://www.MyvNet.com
  日期:      2005.02.18
  参数:      无
  返回值:    无
  说明:      显示程序菜单
-------------------------------------------------------------------------------}
procedure ShowApplicationMenu;
var
  strCmd: string;
  i, j: Integer;
begin
  j := 0;
  for i := 0 to 9 do
  begin
    if (Programs[i].AppName <> '') and
      (Programs[i].AppPath <> '') then
    begin
      strCmd := strCmd + ',"' + Programs[i].AppName + '"';
      Inc(j);
    end;
  end;
  if j = 0 then
  begin
    SendInfoToPhone(strNoApplication);
  end else
  begin
    strCmd := 'AT*EASM="' + strMainMenu1 + '",1,1,' + IntToStr(j) + strCmd;
    SendCmdToComPort(strCmd);
    SelectMenu := pmsApplication;
  end;
end;

{-------------------------------------------------------------------------------
  过程名:    ShowWinampMenu
  作者:      小冬[kendling]
  邮件:      [e-mail]
  主页:      http://www.MyvNet.com
  日期:      2005.02.18
  参数:      无
  返回值:    无
  说明:      显示Winamp菜单
-------------------------------------------------------------------------------}
procedure ShowWinampMenu(const iMenu: Integer);
var
  strCmd: string;
begin
  bPlayList := False;
  if SelectMenu <> pmsWinamp then
  begin
    if not FileExists(strWinampPath) then
    begin
      SendInfoToPhone(strNoWinamp, 3);
      Exit;
    end;
    SendInfoToPhone(strStartWinamp, 3);
    objWinamp.WAPath := strWinampPath;
    objWinamp.StartWinamp();
    if bWinampAutoPlay then
      objWinamp.Play;
  end;
  if not objWinamp.IsFound then
  begin
    SendInfoToPhone(strNoStartWinamp, 3);
    Exit;
  end;

  strCmd := 'AT*EASM="' + strMainMenu2 + '",1,' + IntToStr(iMenu) + ',7';
  strCmd := strCmd + ',"' + strWAMenu1 + '"';
  strCmd := strCmd + ',"' + strWAMenu2 + '"';
  strCmd := strCmd + ',"' + strWAMenu3 + '"';
  strCmd := strCmd + ',"' + strWAMenu4 + '"';  
  strCmd := strCmd + ',"' + strWAMenu5 + '"';
  strCmd := strCmd + ',"' + strWAMenu6 + '"';
  strCmd := strCmd + ',"' + strWAMenu7 + '"';
  SendCmdToComPort(strCmd);
  SelectMenu := pmsWinamp;
end;

{-------------------------------------------------------------------------------
  过程名:    ShowMouseMove
  作者:      小冬[kendling]
  邮件:      [e-mail]
  主页:      http://www.MyvNet.com
  日期:      2005.02.18
  参数:      无
  返回值:    无
  说明:      显示移动鼠标
-------------------------------------------------------------------------------}
procedure ShowMouseMove;
var
  strCmd: string;
begin
  //让手机一直输入按键到计算机，直到计算机通知退出
  strCmd := 'AT*EAID=13,2,"移动鼠标  返回键可退出"';
  SendCmdToComPort(strCmd);
  CaptureKey(True);
  SelectMenu := pmsMouse;
end;

{-------------------------------------------------------------------------------
  过程名:    ShowAbout
  作者:      小冬[kendling]
  邮件:      [e-mail]
  主页:      http://www.MyvNet.com
  日期:      2005.02.18
  参数:      无
  返回值:    无
  说明:      显示关于本程序
-------------------------------------------------------------------------------}
procedure ShowAbout;
var
  strCmd: string;
begin
  strCmd := 'AT*EAID=1,0,"' + strAppName + ' ' + strAppVer + ' ';
  strCmd := strCmd + 'Design: kendling' + #10 + 'www.MyvNet.com"';
  SendCmdToComPort(strCmd);
  SelectMenu := pmsAbout;
end;

{-------------------------------------------------------------------------------
  过程名:    MessageX
  作者:      小冬[kendling]
  邮件:      [e-mail]
  主页:      http://www.MyvNet.com
  日期:      2005.02.07
  参数:      objMessage: TPhoneCMD
  返回值:    Word
             0 - 出错
             1 - 成功
             2 - 无处理
  说明:      分流处理消息
-------------------------------------------------------------------------------}
function MessageX(const objMessage: TPhoneCMD): Word;
var
  tmpStrings: TStrings;
  tmpStr: string;
begin
  Result := 0;
  //读取手机字符状态
  if Copy(objMessage.strCMD, 0, 5) = '+CSCS' then
  begin
    tmpStrings := TStringList.Create;
//    tmpStr := Copy(objMessage.strCMD, 9,
//      Length(objMessage.strCMD)-9);
    tmpStrings.CommaText := Copy(objMessage.strCMD, 9,
      Length(objMessage.strCMD)-9);
    if pCSCS = '' then
    begin
      pCSCS  := tmpStrings[0];
      Result := 1;
    end else
      Result := 2;
    Exit;
  end;
  //读取手机静音状态
  if Copy(objMessage.strCMD, 0, 5) = '*ESIL' then
  begin
    tmpStr := objMessage.strCMD[9];
    if objMessage.strCMD[9] = '1' then
    begin
      pMute  := True;
      Result := 1;
    end else
      Result := 2;
    Exit;
  end;
  //按键处理
  if Copy(objMessage.strCMD, 0, 6) = '+CKEV:' then
  begin
    ProcessKey(objMessage.strCMD);
    Result := 1;
    Exit;
  end;
  //菜单处理
  if (Copy(objMessage.strCMD, 0, 5) = '*EAAI') or
    (Copy(objMessage.strCMD, 0, 5) = '*EAMI') then
  begin
    ProcessMenu(objMessage.strCMD);
    Result := 1;
    Exit;
  end;
  //对话框处理
  if Copy(objMessage.strCMD, 0, 5) = '*EAII' then
  begin
    ProcessDialog(objMessage.strCMD);
    Result := 1;
    Exit;
  end;
end;

{-------------------------------------------------------------------------------
  过程名:    ProcessKey
  作者:      小冬[kendling]
  邮件:      [e-mail]
  主页:      http://www.MyvNet.com
  日期:      2005.02.18
  参数:      const strMessage: string
  返回值:    无
  说明:      处理按键消息
-------------------------------------------------------------------------------}
procedure ProcessKey(const strMessage: string);
var
  strKey:  string;
  KeyDown: Boolean;
begin
  strKey  := strMessage[8] + strMessage[9];
  if strKey[2] = ',' then strKey := strKey[1];
  KeyDown := StrToBool(strMessage[Length(strMessage)]);

  case SelectMenu of
    pmsApplication:
      ProcessMouseKey(StrToKey(strKey), KeyDown);
    pmsWinamp:
      ProcessWinampKey(StrToKey(strKey), KeyDown);
    pmsMouse:
      ProcessMouseKey(StrToKey(strKey), KeyDown);
  end;
end;

{-------------------------------------------------------------------------------
  过程名:    StrToKey
  作者:      小冬[kendling]
  邮件:      [e-mail]
  主页:      http://www.MyvNet.com
  日期:      2005.02.25
  参数:      const strKey: string
  返回值:    TPhoneKey
  说明:      转换键字符到键值
-------------------------------------------------------------------------------}
function StrToKey(const strKey: string): TPhoneKey;
type
  TPhoneKeyCode = record
    Name:  string;
    Value: TPhoneKey;
  end;
const
  MaxPhoneKeyCode = 25;
  PhoneKeyCodes: array[1..MaxPhoneKeyCode] of TPhoneKeyCode =
  (
    (Name:':C'; Value:pkCamaner),
    (Name:':O'; Value:pkOnline),