u_main.pas

利用红外线与手机通信

unit U_Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, SUIForm, WSocket, WIrCOMMSocket, ComCtrls, SUIProgressBar,
  SUISideChannel, SUITitleBar, SUIListView, SUIStatusBar, SUITabControl,
  SUIPageControl, SUIButton, SUIImagePanel, StdCtrls, SUIEdit, ImgList,U_Threade,
  Menus;

const
  ATCommFileName = 'ATComm';
  CQ_RECMESSAGE = WM_USER + 139;

type
  TCQHandleMessage = record
    Msg: Cardinal;
    Message: PChar;
    Length: Longint;
    Result: Longint;
  end;


  TForm_Main = class(TForm)
    suiForm_Main: TsuiForm;
    WIrSocket: TWIrCOMMSocket;
    sSB_Status: TsuiStatusBar;
    LV_ViewInfo: TsuiListView;
    suiPanel1: TsuiPanel;
    sB_Conn: TsuiButton;
    sB_Disconn: TsuiButton;
    IMage: TImage;
    ImageList: TImageList;
    sB_Rescan: TsuiButton;
    Timer_Image: TTimer;
    CB_BXTag: TCheckBox;
    PMenu: TPopupMenu;
    MItem_SendAt: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure sB_ConnClick(Sender: TObject);
    procedure sB_DisconnClick(Sender: TObject);
    procedure Timer_ImageTimer(Sender: TObject);
    procedure sB_RescanClick(Sender: TObject);
    procedure WIrSocketSessionConnected(Sender: TObject; Error: Word);
    procedure WIrSocketSessionClosed(Sender: TObject; Error: Word);
    procedure WIrSocketDataAvailable(Sender: TObject; Error: Word);
    procedure FormDestroy(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure MItem_SendAtClick(Sender: TObject);
  private
    { Private declarations }
    FMessage: String;
    ImageIndx :integer;
    IrDAList: TIrdaDevicesInfo;    //本机红外线设备列表
    FAtCommList :TStrings;         //At 指令集
    FSendTag: Boolean;             //是否允许发送
    CurAtComm : TListItem;         //当前的AT命令

    procedure IniATComm;          //初始化AT命令
    procedure ChangeImage(ind :integer);  //改变图标
    procedure RescanIrCOMM;    //搜索红外线接口
    procedure ConnectIr;        //连接红外线接口
    procedure DisConnectIr;     //断开红外线接口

    procedure SendATComms;       //送所有AT命令
    procedure SendATComm;        //送指定AT命令
  public
    { Public declarations }
    procedure SendDateToSocket(SendData:string);    //送数据
    procedure RecDate;                              //收数据
    procedure RecMessage(var Msg: TCQHandleMessage); message CQ_RECMESSAGE;
  end;




var
  Form_Main: TForm_Main;

implementation

{$R *.DFM}

{ TForm_Main }

procedure TForm_Main.IniATComm;
Var
  sAtCommLI:  TListItem;
  AtCommList,strList: TStrings;
  i:integer;
begin
  FAtCommList.Clear;
  AtCommList := TStringList.Create;
  strList    := TStringList.Create;
  Try
    AtCommList.LoadFromFile(ATCommFileName);
    if AtCommList.Count = 0 then
       raise Exception.Create('没有AT指令！');

    LV_ViewInfo.Items.Clear;
    For i:=0  to AtCommList.Count - 1 do
      begin
        strList.Clear;
        strList.CommaText := Trim(AtCommList[i]);
        sAtCommLI := LV_ViewInfo.Items.Add;
        sAtCommLI.Caption :=  strList[0];           //AT指令
        FAtCommList.Add(strList[0]);                //添加到AT指令集中

        sAtCommLI.SubItems.Add('');                 //手机返回信息
        sAtCommLI.SubItems.Add(Trim(strList[1]));   //AT指令说明
        sAtCommLI.SubItems.Add('');                 //状态
      end;


  Finally
    strList.Free;
    AtCommList.Free;
  End;

end;

procedure TForm_Main.FormCreate(Sender: TObject);
begin
FAtCommList := TStringList.Create;
ImageIndx := 0;
ChangeImage(0);
IniATComm;
end;

procedure TForm_Main.ChangeImage(ind: integer);
var
  stBit :TBitmap;
begin
   stBit := TBitmap.Create;
   try
     ImageList.GetBitmap(ind,stBit);
     Image.Picture.Assign(stBit);
   finally
     stBit.Free;
   end;
end;

procedure TForm_Main.sB_ConnClick(Sender: TObject);
begin
ConnectIr;
sleep(1000);
SendATComms;
end;

procedure TForm_Main.sB_DisconnClick(Sender: TObject);
begin
DisConnectIr;
end;

procedure TForm_Main.RescanIrCOMM;
begin
  sSB_Status.panels[0].Text := 'Scanning...';
  Timer_Image.Enabled := True;

  Try
    WIrSocket.Close;
    FreeAndNil(IrDAList);
    IrDAList := WIrSocket.GetConnectedDevices;

    if IrDAList.Count = 0
      then
         begin
           sSB_Status.panels[0].Text := '没有红外线设备!';
           ChangeImage(0);
           sB_Conn.Enabled := False;
           sB_Disconn.Enabled := False;
           MItem_SendAt.Enabled := False;
         end
      else
         begin
           sSB_Status.panels[0].Text := IrDAList.Items[0].irdaDeviceName;
           ChangeImage(1);
           sB_Conn.Enabled := True;
           sB_Disconn.Enabled := True;
           MItem_SendAt.Enabled := True;
         end;
  Finally

  End;
  Timer_Image.Enabled := False;
end;

procedure TForm_Main.Timer_ImageTimer(Sender: TObject);
begin
  Timer_Image.Enabled := False;
  if ImageIndx = 6 then  ImageIndx := 0;
  ChangeImage(ImageIndx);
  inc(ImageIndx);
  Timer_Image.Enabled := True;
end;

procedure TForm_Main.sB_RescanClick(Sender: TObject);
begin
   RescanIrCOMM;
end;

procedure TForm_Main.WIrSocketSessionConnected(Sender: TObject;
  Error: Word);
begin
   sSB_Status.panels[1].Text := 'Connected';
end;

procedure TForm_Main.ConnectIr;
begin
  Timer_Image.Enabled := True;
  sSB_Status.panels[1].Text := 'Connecting...';
  WIrSocket.Close;
  WIrSocket.DeviceID := IrDAList[0].irdaDeviceID;
  WIrSocket.Connect;
  Timer_Image.Enabled := False;
  ChangeImage(1);
end;

procedure TForm_Main.DisConnectIr;
begin
  Timer_Image.Enabled := True;
  sSB_Status.panels[1].Text := 'Disconnected...';
  WIrSocket.Close;
  Timer_Image.Enabled := False;
  ChangeImage(0);
end;

procedure TForm_Main.WIrSocketSessionClosed(Sender: TObject; Error: Word);
begin
  sSB_Status.panels[1].Text := 'Disconnected';
end;

procedure TForm_Main.SendDateToSocket(SendData: string);
begin
    if Trim(SendData) = '' then raise Exception.Create('AT命令不能为空!');
    with TSendThread.Create(SendData,WIrSocket) do
      try
          while not Finished do begin
            Application.ProcessMessages;
            Sleep(25);
          end;
      finally
         Free;
      end;
    if CB_BXTag.Checked then  exit  // 并行
    else
       begin            //串行
         FSendTag := False;
          while Not FSendTag do begin
            Application.ProcessMessages;
            Sleep(25);
          end;
       end;
end;

procedure TForm_Main.SendATComms;
var
 i :integer;
 AtCommStr :string;
begin
 Timer_Image.Enabled := True;
 For i:=0 to LV_ViewInfo.Items.Count - 1 do
   begin
      AtCommStr := Trim(LV_ViewInfo.Items[i].Caption);
      LV_ViewInfo.Items[i].SubItems[2] := 'Wait...';
      SendDateToSocket(AtCommStr);
   end;
 Timer_Image.Enabled := False;
end;

procedure TForm_Main.WIrSocketDataAvailable(Sender: TObject; Error: Word);
begin
  RecDate;
end;

procedure TForm_Main.RecDate;
var
  c: char;
  i: Integer;
  buffer: String;
  PStr: PChar;
begin
    SetLength(buffer, 2048);
    SetLength(buffer, WIrSocket.Receive(@buffer[1], 2048));

    for i := 1 to length(buffer) do
     begin
        c := buffer[i];
        case c of
          #00:;
          #10:;
          #13:
            begin
              if length(trim(FMessage)) > 0 then
              begin
                PStr := StrNew(PChar(FMessage));
                PostMessage(Handle, CQ_RECMESSAGE, Integer(PStr), 0);
              end;
              FMessage := '';
            end;
          else begin
            FMessage := FMessage + c;
          end;
        end;

        {if (FMessage = FWaitStr) and (FMessage <> '') then
          begin
            PStr := StrNew(PChar(FMessage));
            PostMessage(Handle, FMA_HANDLEMESSAGE, Integer(PStr), 0);
            FMessage := '';
          end;      }
     end;
end;

procedure TForm_Main.RecMessage(var Msg: TCQHandleMessage);
var
   AMsg: String;
   i:integer;
begin
   AMsg := Msg.Message;
   StrDispose(Msg.Message);

   AMsg := Trim(AMsg);

   i := FAtCommList.IndexOf(AMsg);
   if i >= 0 then
        CurAtComm := LV_ViewInfo.Items[i]
   else
     begin
       if (Pos('ERROR',AMsg) = Pos('OK',AMsg))
         then  CurAtComm.SubItems[0] :=  AMsg
         else
           begin
            CurAtComm.SubItems[2] :=  AMsg;
            FSendTag := True;
           end;
     end;
end;

procedure TForm_Main.FormDestroy(Sender: TObject);
begin
FAtCommList.Free;
end;

procedure TForm_Main.FormClose(Sender: TObject; var Action: TCloseAction);
begin
DisConnectIr;
end;

procedure TForm_Main.SendATComm;
var
  AtCommStr :String;
begin
  Timer_Image.Enabled := True;
  if LV_ViewInfo.Selected = nil then Exit;
  AtCommStr := Trim(LV_ViewInfo.Selected.Caption);
  LV_ViewInfo.Selected.SubItems[2] := 'Wait...';
  SendDateToSocket(AtCommStr);
  Timer_Image.Enabled := False;
end;

procedure TForm_Main.MItem_SendAtClick(Sender: TObject);
begin
ConnectIr;
sleep(3000);
SendATComm;
end;

end.