smsredskyimpl.pas

本控件适用于WAVECOM模块

unit SMSRedSkyImpl;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ActiveX, AxCtrls, SMSRedSky_TLB, StdVcl, StdCtrls, SPComm, Buttons;

type
   //发送短信线程
  TSendSMSThread = class(TThread)
    M_Temp: TMemo;
    Comm1: TComm;
   private
     ID_Phone,  //车载电话
     ID_Mission,//控制命令
     ID_Text:string;  //派车单
   protected
     procedure execute; override;
     procedure SendSMSToCom;
     Function  MakeInfo_UnicodeGBK(SendTel,Mission,AlarmInfo:string):string;  //Unicode GBk编码
     function  EncodeGb(s: WideString): string; //Unicode 编码
     Function TextToGBK(Text:string):string; //汉字转换成GBK编码
     function ConvertPhoneNum(PhoneNum: string): string; //电话号码转换成Unicode编码
     Function InitStartSendMode(sign:string):string; //开始发送初始化
     Function SendInfoToCom(Text:string):string;    //发送信息到Com口
  Public
    Constructor Create(Suspended:Boolean;Phone,Mission,Text:string;Temp:Tmemo;Comname:Tcomm);
  end;
  //读取短信线程
  TReadTranslateThread = class(TThread)
    M: TMemo;
    Comm1: TComm;
   private
     ID_Index:string;  //短信息的内存号  
   protected
     procedure execute; override;
     procedure TranslateSMS;
     
  Public 
    Constructor Create(Suspended:Boolean;Index:string;Memo:Tmemo;Commname:Tcomm);
     Function InitStartSendMode(Sign:string):string;
     Function ReadInfo(index:string):string;
     Function DeleteInfo(index:string):string;
  end;
  TRedSky = class(TActiveForm, IRedSky)
    Comm1: TComm;
    GroupBox1: TGroupBox;
    M_ComEvent: TMemo;
    GroupBox2: TGroupBox;
    M: TMemo;
    procedure Comm1ReceiveData(Sender: TObject; Buffer: Pointer;
      BufferLength: Word);
    private
    { Private declarations }
    FEvents: IRedSkyEvents;
    procedure ActivateEvent(Sender: TObject);
    procedure ClickEvent(Sender: TObject);
    procedure CreateEvent(Sender: TObject);
    procedure DblClickEvent(Sender: TObject);
    procedure DeactivateEvent(Sender: TObject);
    procedure DestroyEvent(Sender: TObject);
    procedure KeyPressEvent(Sender: TObject; var Key: Char);
    procedure PaintEvent(Sender: TObject);
  protected
    { Protected declarations }
    procedure DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage); override;
    procedure EventSinkChanged(const EventSink: IUnknown); override;
    function Get_Active: WordBool; safecall;
    function Get_AlignDisabled: WordBool; safecall;
    function Get_AutoScroll: WordBool; safecall;
    function Get_AutoSize: WordBool; safecall;
    function Get_AxBorderStyle: TxActiveFormBorderStyle; safecall;
    function Get_Caption: WideString; safecall;
    function Get_Color: OLE_COLOR; safecall;
    function Get_Cursor: Smallint; safecall;
    function Get_DoubleBuffered: WordBool; safecall;
    function Get_DropTarget: WordBool; safecall;
    function Get_Enabled: WordBool; safecall;
    function Get_Font: IFontDisp; safecall;
    function Get_HelpFile: WideString; safecall;
    function Get_HelpKeyword: WideString; safecall;
    function Get_HelpType: TxHelpType; safecall;
    function Get_KeyPreview: WordBool; safecall;
    function Get_PixelsPerInch: Integer; safecall;
    function Get_PrintScale: TxPrintScale; safecall;
    function Get_Scaled: WordBool; safecall;
    function Get_Visible: WordBool; safecall;
    function Get_VisibleDockClientCount: Integer; safecall;
    procedure _Set_Font(var Value: IFontDisp); safecall;
    procedure AboutBox; safecall;
    procedure Set_AutoScroll(Value: WordBool); safecall;
    procedure Set_AutoSize(Value: WordBool); safecall;
    procedure Set_AxBorderStyle(Value: TxActiveFormBorderStyle); safecall;
    procedure Set_Caption(const Value: WideString); safecall;
    procedure Set_Color(Value: OLE_COLOR); safecall;
    procedure Set_Cursor(Value: Smallint); safecall;
    procedure Set_DoubleBuffered(Value: WordBool); safecall;
    procedure Set_DropTarget(Value: WordBool); safecall;
    procedure Set_Enabled(Value: WordBool); safecall;
    procedure Set_Font(const Value: IFontDisp); safecall;
    procedure Set_HelpFile(const Value: WideString); safecall;
    procedure Set_HelpKeyword(const Value: WideString); safecall;
    procedure Set_HelpType(Value: TxHelpType); safecall;
    procedure Set_KeyPreview(Value: WordBool); safecall;
    procedure Set_PixelsPerInch(Value: Integer); safecall;
    procedure Set_PrintScale(Value: TxPrintScale); safecall;
    procedure Set_Scaled(Value: WordBool); safecall;
    procedure Set_Visible(Value: WordBool); safecall;
    procedure SendSMS(const Phone, Mission, SMS: WideString); safecall;
    procedure ReadAllSMSFromGSM; safecall;
     
  public
    { Public declarations }
    OnComReceiveSMS: TRedSkyOnComReceiveSMS;
    procedure Initialize; override;
    function Init(const Com, BaudRate, SMSCenter: WideString): Integer;
      safecall;
    procedure ComReceiveSMS(Sender: TObject;var PhoneNum: WideString; var SMS: WideString);safecall;

    //=============(自定义函数) 2004========================
    Function InitSMSCenter(SMSCenter,BaudRate,Com:Widestring):integer;
    Function FromComInfo_SortChoose(Recie_STR:string):string;
    function CopyText(var TelNum:widestring;Str:widestring):widestring;
    Function FromTel(STR:widestring):widestring;
    function UniCode2GB(S : wideString):wideString;
    Function RecieveOKTMSG(var TelNum:widestring;Str:widestring):widestring;
    Function RecieveHandOK(var TelNum:widestring;Str:widestring):widestring;
    Function ReadComSMS(Str:string):string;
    Function InitStartSendMode(Sign:widestring):widestring;
    Function ReadInfo(index:widestring):widestring;
    Function DeleteInfo(index:widestring):widestring;
    function WideStrToCh(S: String): string; //
  end;
var
  SendMutex: THandle; //模糊查询 线程句柄
  ReadMutex: THandle; //模糊查询 线程句柄

implementation

uses ComObj, ComServ, About;

{$R *.DFM}

{ TRedSky }

procedure TRedSky.ComReceiveSMS(Sender: TObject;var PhoneNum: WideString; var SMS: WideString);
var
 S,R:widestring;
begin
  if FEvents <> nil then
    begin
      FEvents.OnComReceiveSMS(s,r);
      PhoneNum:=s;
      SMS:=r;
    end;

end;
procedure TRedSky.DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage);
begin
  { Define property pages here.  Property pages are defined by calling
    DefinePropertyPage with the class id of the page.  For example,
      DefinePropertyPage(Class_RedSkyPage); }
end;

procedure TRedSky.EventSinkChanged(const EventSink: IUnknown);
begin
  FEvents := EventSink as IRedSkyEvents;
  inherited EventSinkChanged(EventSink);
end;

procedure TRedSky.Initialize;
begin
  inherited Initialize;
  OnActivate := ActivateEvent;
  OnClick := ClickEvent;
  OnCreate := CreateEvent;
  OnDblClick := DblClickEvent;
  OnDeactivate := DeactivateEvent;
  OnDestroy := DestroyEvent;
  OnKeyPress := KeyPressEvent;
  OnPaint := PaintEvent;
end;

function TRedSky.Get_Active: WordBool;
begin
  Result := Active;
end;

function TRedSky.Get_AlignDisabled: WordBool;
begin
  Result := AlignDisabled;
end;

function TRedSky.Get_AutoScroll: WordBool;
begin
  Result := AutoScroll;
end;

function TRedSky.Get_AutoSize: WordBool;
begin
  Result := AutoSize;
end;

function TRedSky.Get_AxBorderStyle: TxActiveFormBorderStyle;
begin
  Result := Ord(AxBorderStyle);
end;

function TRedSky.Get_Caption: WideString;
begin
  Result := WideString(Caption);
end;

function TRedSky.Get_Color: OLE_COLOR;
begin
  Result := OLE_COLOR(Color);
end;

function TRedSky.Get_Cursor: Smallint;
begin
  Result := Smallint(Cursor);
end;

function TRedSky.Get_DoubleBuffered: WordBool;
begin
  Result := DoubleBuffered;
end;

function TRedSky.Get_DropTarget: WordBool;
begin
  Result := DropTarget;
end;

function TRedSky.Get_Enabled: WordBool;
begin
  Result := Enabled;
end;

function TRedSky.Get_Font: IFontDisp;
begin
  GetOleFont(Font, Result);
end;

function TRedSky.Get_HelpFile: WideString;
begin
  Result := WideString(HelpFile);
end;

function TRedSky.Get_HelpKeyword: WideString;
begin
  Result := WideString(HelpKeyword);
end;

function TRedSky.Get_HelpType: TxHelpType;
begin
  Result := Ord(HelpType);
end;

function TRedSky.Get_KeyPreview: WordBool;
begin
  Result := KeyPreview;
end;

function TRedSky.Get_PixelsPerInch: Integer;
begin
  Result := PixelsPerInch;
end;

function TRedSky.Get_PrintScale: TxPrintScale;
begin
  Result := Ord(PrintScale);
end;

function TRedSky.Get_Scaled: WordBool;
begin
  Result := Scaled;
end;

function TRedSky.Get_Visible: WordBool;
begin
  Result := Visible;
end;

function TRedSky.Get_VisibleDockClientCount: Integer;
begin
  Result := VisibleDockClientCount;
end;

procedure TRedSky._Set_Font(var Value: IFontDisp);
begin
  SetOleFont(Font, Value);
end;

procedure TRedSky.AboutBox;
begin
  ShowRedSkyAbout;
end;

procedure TRedSky.ActivateEvent(Sender: TObject);
begin
  if FEvents <> nil then FEvents.OnActivate;
end;

procedure TRedSky.ClickEvent(Sender: TObject);
begin
  if FEvents <> nil then FEvents.OnClick;
end;

procedure TRedSky.CreateEvent(Sender: TObject);
begin
  if FEvents <> nil then FEvents.OnCreate;
end;

procedure TRedSky.DblClickEvent(Sender: TObject);
begin
  if FEvents <> nil then FEvents.OnDblClick;
end;

procedure TRedSky.DeactivateEvent(Sender: TObject);
begin
  if FEvents <> nil then FEvents.OnDeactivate;
end;

procedure TRedSky.DestroyEvent(Sender: TObject);
begin
  if FEvents <> nil then FEvents.OnDestroy;
end;

procedure TRedSky.KeyPressEvent(Sender: TObject; var Key: Char);
var
  TempKey: Smallint;
begin
  TempKey := Smallint(Key);
  if FEvents <> nil then FEvents.OnKeyPress(TempKey);
  Key := Char(TempKey);
end;

procedure TRedSky.PaintEvent(Sender: TObject);
begin
  if FEvents <> nil then FEvents.OnPaint;
end;

procedure TRedSky.Set_AutoScroll(Value: WordBool);
begin
  AutoScroll := Value;
end;

procedure TRedSky.Set_AutoSize(Value: WordBool);
begin
  AutoSize := Value;
end;

procedure TRedSky.Set_AxBorderStyle(Value: TxActiveFormBorderStyle);
begin
  AxBorderStyle := TActiveFormBorderStyle(Value);
end;

procedure TRedSky.Set_Caption(const Value: WideString);
begin
  Caption := TCaption(Value);
end;

procedure TRedSky.Set_Color(Value: OLE_COLOR);
begin
  Color := TColor(Value);
end;

procedure TRedSky.Set_Cursor(Value: Smallint);
begin
  Cursor := TCursor(Value);
end;

procedure TRedSky.Set_DoubleBuffered(Value: WordBool);
begin
  DoubleBuffered := Value;
end;

procedure TRedSky.Set_DropTarget(Value: WordBool);
begin
  DropTarget := Value;
end;

procedure TRedSky.Set_Enabled(Value: WordBool);
begin
  Enabled := Value;
end;

procedure TRedSky.Set_Font(const Value: IFontDisp);
begin
  SetOleFont(Font, Value);
end;