umobileagentui.pas

来自「FMA is a free1 powerful phone editing to」· PAS 代码 · 共 579 行 · 第 1/2 页

PAS
579
字号
unit uMobileAgentUI;

{
*******************************************************************************
* Descriptions: COM/Script Interface implementation
* $Source: /cvsroot/fma/fma/uMobileAgentUI.pas,v $
* $Locker:  $
*
* Todo:
*
* Change Log:
* $Log: uMobileAgentUI.pas,v $
*
*******************************************************************************
}

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  gnugettext, gnugettexthelpers,
  ComObj, ActiveX, MobileAgent_TLB, StdVcl, Classes, TntClasses, Menus, TntMenus, ExtCtrls, TntExtCtrls;

type
  TMobileAgentApp = class(TAutoObject, IMobileAgentApp)
  private
    sl: TStrings;
    tl: TStrings;
    rootMenu: TTntMenuItem;
    ScriptGnuGettextInstance: TGnuGettextInstance;
  protected
    procedure AddCmd(const label_, event: WideString); safecall;
    procedure Connect; safecall;
    procedure Disconnect; safecall;
    procedure Exit; safecall;
    function Get_KeyPress: WideString; safecall;
    function Get_PopKey: WideString; safecall;
    procedure Debug(const str: WideString); safecall;
    procedure ClearKey; safecall;
    procedure Status(const Str: WideString); safecall;
    procedure Minimize; safecall;
    procedure Restore; safecall;
    procedure Set_KeyInActivityTimeout(Value: Integer); safecall;
    procedure Transmit(const Cmd: WideString); safecall;
    function Get_Connected: Integer; safecall;
    function Get_LookupByNumber(const Number: WideString): WideString; safecall;
    function Get_Received: WideString; safecall;
    procedure SentMessage(const Msg, DestNo: WideString; ReqReply, Flash, StatusReq: Smallint); safecall;
    procedure ObexPut(const filename: WideString); safecall;
    procedure VoiceAnswer; safecall;
    procedure VoiceCall(const Number: WideString); safecall;
    procedure VoiceHangUp; safecall;
    function ObexGetObj(const filename, objecturl: WideString): HResult; safecall;
    function ObexPutObj(const filename, objecturl: WideString): HResult; safecall;
    function ObexGet(const filename, objectname: WideString): HResult; safecall;
    procedure ObexDelete(const objectname: WideString); safecall;
    function ObexCut(const filename, objectname: WideString): HResult; safecall;
    procedure AddTimer(msec: Integer; const event: WideString); safecall;
    procedure DeleteTimer(const event: WideString); safecall;
    procedure EnableKeyMonitor; safecall;
    procedure DisableKeyMonitor; safecall;
    procedure ScriptCall(const Code: WideString); safecall;
    procedure Sleep(msec: Integer); safecall;
    function Get_PhoneType(const Number: WideString): WideString; safecall;
    procedure DisconnectTemporary; safecall;
    function dGetText(const Domain, szMsgId: WideString): WideString; safecall;
    function dnGetText(const Domain, Singular, Plural: WideString; Number: Integer): WideString; safecall;
    function GetCurrentLocale: WideString; safecall;
    function Get_PhoneModel: WideString; safecall;
    procedure AddTip(const atip: WideString; atimeoutsecs: Integer; ashownow: Smallint); safecall;
    procedure ClearTips; safecall;
    procedure AddBaloon(const atext: WideString; atimeoutsecs: Integer); safecall;
    procedure HideBaloon; safecall;
    function Get_MobileAgentFolder: WideString; safecall;
    function Get_ScriptFolder: WideString; safecall;
    function PhoneDecode(aText: OleVariant): WideString; safecall;
    function PhoneEncode(const aText: WideString): OleVariant; safecall;
    function Get_isT610clone: WordBool; safecall;
    function Get_isK750clone: WordBool; safecall;
    function Get_isK750orBetter: WordBool; safecall;
  public
    procedure Initialize; override;
    destructor Destroy; override;
    procedure MenuClicked(Sender: TObject);
    procedure TimerEvent(Sender: TObject);
  end;

implementation

uses
  cUnicodeCodecs,
  ComServ, Unit1, SysUtils, TntSysUtils, Dialogs, TntDialogs, uObex,
  uSyncPhonebook, uLogger, uThreadSafe, uWelcome;

const
  rootCount: integer = 0;

procedure TMobileAgentApp.AddCmd(const label_, event: WideString);
var
  menuItem: TTntMenuItem;
begin
  if Assigned(rootMenu) then begin
    menuItem := TTntMenuItem.Create(Form1.MainMenu1);
    menuItem.Caption := label_;
    menuItem.Tag := sl.Count;
    menuItem.OnClick := MenuClicked;
    rootMenu.Add(menuItem);
    rootMenu.Enabled := True;
  end;
  sl.Add(IntToStr(sl.Count) + '=' + event);
end;

procedure TMobileAgentApp.Initialize;
var
  SaveExecutableFilename: String;
begin
  inherited;
  sl := TStringList.Create;
  tl := TStringList.Create;

  with Form1.MainMenu1 do begin
    rootMenu := Form1.MyMenu1;
    rootMenu.Enabled := False;
    if rootCount = 0 then rootCount := rootMenu.Count;
  end;

  SaveExecutableFilename := ExecutableFilename;
  ExecutableFilename := Form1.ScriptFilename;
  ScriptGnuGettextInstance := TGnuGettextInstance.Create;
  ScriptGnuGettextInstance.textdomain(getcurrenttextdomain);
  ScriptGnuGettextInstance.UseLanguage(GetCurrentLanguage);
  ExecutableFilename := SaveExecutableFilename;
end;

procedure TMobileAgentApp.MenuClicked(Sender: TObject);
var
  tag: Integer;
  cmd: String;
begin
  tag := (Sender as TTntMenuItem).Tag;
  cmd := sl.Values[IntToStr(tag)];

  Form1.CallScriptMethod(cmd,[]);
end;

procedure TMobileAgentApp.Connect;
begin
  Form1.ActionConnectionConnect.Execute;
end;

procedure TMobileAgentApp.Disconnect;
begin
  Form1.ActionConnectionDisconnect.Execute;
end;

procedure TMobileAgentApp.Exit;
begin
  Form1.ActionExit.Execute;
end;

function TMobileAgentApp.Get_KeyPress: WideString;
begin
  Result := Form1.FKeyActivity;
end;

function TMobileAgentApp.Get_PopKey: WideString;
begin
  Result := Copy(Form1.FKeyActivity, length(Form1.FKeyActivity), 1);
  Form1.FKeyActivity := Copy(Form1.FKeyActivity, 1, length(Form1.FKeyActivity) - 1);
end;

procedure TMobileAgentApp.EnableKeyMonitor;
begin
  Form1.EnableKeyMonitor(True);
end;

procedure TMobileAgentApp.Debug(const str: WideString);
begin
  Log.AddScriptMessage('[Script] ' + str, lsDebug); // do not localize debug
end;

procedure TMobileAgentApp.ClearKey;
begin
  Form1.FKeyActivity := '';
end;

procedure TMobileAgentApp.Status(const Str: WideString);
begin
  Form1.Status(Str);
end;

procedure TMobileAgentApp.Minimize;
begin
  Form1.MinimizeApp;
end;

procedure TMobileAgentApp.Restore;
begin
  Form1.ActionWindowRestore.Execute;
end;

procedure TMobileAgentApp.Set_KeyInActivityTimeout(Value: Integer);
begin
  Log.AddScriptMessage('KeyInactivityTimeout set to ' + IntToStr(Value) + 'ms', lsDebug); // do not localize debug
  Form1.FKeyInactivityTimeout := Value;
end;

procedure TMobileAgentApp.Transmit(const Cmd: WideString);
begin
  Form1.ScheduleTxAndWait(WideStringToUTF8String(Cmd));
end;

function TMobileAgentApp.Get_Connected: Integer;
begin
  if Form1.FConnected then Result := 1
  else Result := 0;
end;

function TMobileAgentApp.Get_LookupByNumber(
  const Number: WideString): WideString;
begin
  Result := Form1.LookupContact(Number);
end;

function TMobileAgentApp.Get_Received: WideString;
begin
  Result := ThreadSafe.RxBuffer.Text;
end;

procedure TMobileAgentApp.SentMessage(const Msg, DestNo: WideString;
  ReqReply, Flash, StatusReq: Smallint);
var
  AReqReply, AFlash, AStatusReq: Boolean;
begin
  if ReqReply = 0 then AReqReply := False
  else AReqReply := True;

  if Flash = 0 then AFlash := False
  else AFlash := True;

  if StatusReq = 0 then AStatusReq := False
  else AStatusReq := True;

  // TODO: fix for sending long messages
  Form1.SendTextMessage('', Msg, DestNo, AReqReply, AFlash, AStatusReq);
end;

procedure TMobileAgentApp.ObexPut(const filename: WideString);
begin
  Form1.ObexPutFile(filename);
end;

procedure TMobileAgentApp.VoiceAnswer;
begin
  Form1.VoiceAnswer;
end;

procedure TMobileAgentApp.VoiceCall(const Number: WideString);
begin
  Form1.VoiceCall(Number);
end;

procedure TMobileAgentApp.VoiceHangUp;
begin
  Form1.VoiceHangUp;
end;

function TMobileAgentApp.ObexGetObj(const filename,
  objecturl: WideString): HResult;
var
  fs: TFileStream;
begin
  Result := 0; // error
  try
    fs := TFileStream.Create(filename,fmCreate);
    try
      with Form1 do begin
        ObexConnect;
        try
          ObexGetObject(objecturl,TStream(fs));
        finally
          ObexDisconnect;
        end;
      end;
      Result := 1;
    finally
      fs.Free;
    end;
  except

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?