⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 unit1.pas

📁 FMA is a free1 powerful phone editing tool allowing users to easily manage all of the personal data
💻 PAS
📖 第 1 页 / 共 5 页
字号:

    function ObexListFolder(Path: WideString; Connect: boolean = true): string; overload;

    { Diagram }
    function IsEBCAEnabled: boolean;
    function CanUseEBCA(IgnoreConnectingState: boolean = False): boolean;
    procedure EBCAState(Enable: Boolean; KeyMonToo: Boolean = True);

    { Text Messages }
    function IsMoveToArchiveEnabled: boolean;
    procedure DownloadMessages(Node: PVirtualNode);
    procedure DownloadAllMessages;
    procedure SMSToFolder(FolderNode: PVirtualNode);
    function SMSNewFolder(ParentNode: PVirtualNode; AName: WideString): PVirtualNode;
    function IsCorrectSMSFolderName(AName: WideString): boolean;
    function IsNewSMSFolderNameOK(AParentNode: PVirtualNode; AName: WideString): WideString;
    function IsNewPhoneNameOK(AName: WideString): WideString;

    procedure RenderSavedSearches;

    { Phonebook }
    function AddNewToPhonebook(Number: string): boolean;
    procedure DownloadPhonebook(var ABuffer: string);

    { This allows calling object methods as well (m.func) }
    procedure CallScriptMethod(FunctionName: string; Params: array of Variant);
    function ApplyEditorChanges(SaveOnly: Boolean = False): boolean;

    procedure RenderContactLists;
    procedure RenderContactList(var rootNode: PVirtualNode);

    { Organizer }
    procedure RenderBookmarkList(var rootNode: PVirtualNode);

    { Phone Database }
    function GetPhoneIdentity: string;
    procedure SetPhoneIdentity(ID: string);
    function ExtractPhoneIdentity(var Model,Serial: string): string;

    function GetAppDataPath: string;
    function GetDatabasePath: string;
    function GetProfilePath(OverrideID: string = ''): string;

    function PhoneExists(AName: WideString): boolean;
    function PhoneUnique(AName,AIdentity: WideString): boolean;

    procedure LoadSMSMessages(sl: THashedStringList; APath: String);
    procedure SaveSMSMessages(sl: THashedStringList; APath: String);
    procedure ClearSMSMessages(sl: TStringList); overload;
    procedure ClearSMSMessages(Node: PVirtualNode); overload;

    procedure AddStatusReportToList(Report: TSMSStatusReport);
    procedure LoadStatusReports(APath: String);
    procedure FreeStatusReports;

    function LoadPhoneDataFiles(ID: string = ''; ShowStatus: Boolean = True; ShowProgress: Boolean = False; SaveLocalChanges: Boolean = True): boolean;
    function OpenPhoneDataFiles(ID: string = ''): boolean;
    procedure DeletePhoneDataFiles(ID: string; Wnd: THandle = 0);
    procedure RepairPhoneDataFiles(ID: string);
    procedure SavePhoneDataFiles(ShowStatus: Boolean = False);

    procedure LoadUserFoldersData(DBPath: string; ShowUnreadFolders: Boolean = True);
    procedure SaveUserFoldersData(DBPath: string);

    function GetSMSDeliveryNode(Sender: WideString; CustomRules: WideString = '';
      AllowDefaultArchive: Boolean = True): PVirtualNode;
    function GetNodeText(Node: PVirtualNode): WideString;
    procedure EditSMSDeliveryRules(Node: PVirtualNode);

    procedure ClearExplorerViews;

    { Text Messages }
    function GetChatWindow(Contact: string; AllowCreateNew: boolean = False): TfrmCharMessage;
    procedure ChatNotifyDel(PDU: String);

    function UpdateNewMessagesCounter(rootNode: PVirtualNode; ModifyPDU: string = ''; MarkAsRead: boolean = True): integer;
    function GetNewMessagesCounter(rootNode: PVirtualNode): integer;

    procedure SaveMsgToFolder(var rootNode: PVirtualNode; PDU: String;
      OverwriteOld: boolean = false; AsNew: boolean = true; UpdateView: boolean = true;
      ForceIndex: Integer = -1; ForceDate: TDateTime = 0; AllowDuplicates: Boolean = false); overload;
    procedure SaveMsgToFolder(var rootNode: PVirtualNode; msgData: TFmaMessageData;
      OverwriteOld: boolean = false; AsNew: boolean = true; UpdateView: boolean = true;
      ForceIndex: Integer = -1); overload;
    function DelMsgFromFolder(var rootNode: PVirtualNode; PDU: string; UpdateView: boolean = True): Boolean;
    function DeleteSMS(index: Integer; memType: String; CheckPDU: String = ''): Boolean;

    function GetNextLongSMSRefference: string;
    procedure SendTextMessage(const UDHI: String; const msg: WideString; const destNo: WideString; reqReply: Boolean = False;
      Flash: Boolean = False; StatusReq: Boolean = False; dcs: TGSMCodingScheme = gcsUnknown; SaveDraft: Boolean = False);

    function GetStatus: WideString;
    procedure Status(str: WideString; AddToLog: Boolean = True);

    procedure TxAndWait(Data: string; WaitStr: String = 'OK'); // do not localize
    procedure ScheduleTxAndWait(Data: string; WaitStr: String = 'OK'); // do not localize

    function LookupContact(Number: WideString; DefaultName: WideString = ''): WideString;
    function LookupNumber(Contact: WideString): String;

    function LookupContactGroups(Contact: WideString): String;

    procedure InitAlarms;
    procedure InitProfile;
    procedure InitGroups;
    procedure InitCalls; overload;
    procedure InitCalls(Node: PVirtualNode); overload;
    procedure InitObexFolders;
    procedure InitBookmarks;
    procedure InitCalendar;

    function ExplorerFindExtImage(Ext: string): integer;

    procedure ExplorerAddToGroup(GroupIndex: integer; Contact: WideString; Number: String);
    procedure ExplorerDelFromGroup(GroupIndex: integer; Contact: WideString);

    function ExplorerFindNode(NodePath: WideString; ParentNode: PVirtualNode = nil; AllowCreate: Boolean = False): PVirtualNode;
    function ExplorerNodePath(Node: PVirtualNode; SepChar: WideChar = '\'; StripTokens: Integer = 0): WideString;

    function ExplorerNodeIsFileOrFolder(Node: PVirtualNode): Boolean;

    function WhereisContact(SearchFor: WideString; Mode: TFindContactMode): TFindContactResult; // see comments in function!

    procedure ExtractName(var Name,numType: WideString);
    function ExtractNumber(ContactNumber: WideString): WideString;
    function ExtractContact(ContactNumber: WideString): WideString;

    { Next two funcs will return 'name [number]' if found }
    function ContactNumberByTel(ContactNumber: string): WideString;
    function ContactNumberByName(ContactName: WideString): WideString;

    function IsIrmcSyncEnabled: boolean;

    function IsContactNumberSelected: boolean;
    function LocateSelContactNumber: WideString;
    function GetPartialNumber(Number: string): string;

    function LocatePBName(Where: string; Index: integer): WideString; overload;
    function LocatePBName(Where: string; Index: integer; var Number: string): WideString; overload;
    function LocatePBIndex(Where: string; Person: WideString; Phone: string): integer;

    function WriteSMS(memLocation, PDU: String; Stat: Integer = -1): boolean;

    procedure RefreshPhoneBook;
    procedure RefreshSendersView;
    
    procedure UpdateMEPhonebook;
    procedure UpdateSMPhonebook;

    procedure EnableKeyMonitor(TxDelay: boolean = False);
    procedure DisableKeyMonitor(TxDelay: boolean = False);

    procedure MinimizeApp;

    procedure VoiceCall(number: String);
    procedure VoiceAnswer;
    procedure VoiceHangUp(SilentMode: boolean = False);

    procedure DoAbort;
    procedure DoConnect;
    procedure DoDisconnect;
    procedure DoDisconnectTemporary;
    procedure AskRequestConnection;
    procedure RequestConnection(DoNotRefreshView: boolean = True);

    procedure DoProximityNear;
    procedure DoProximityAway;
    procedure DoProximityTest;

    procedure DoCallContact(ContactNumber: WideString);

    procedure DoProcessRules(Node: PVirtualNode; Rules: WideString = '');
    procedure DoProcessInbox;
    procedure DoProcessOutbox;

    procedure DoCleanupOutbox;
    procedure DoRefreshCallSenders;

    function GetSMSMembers(Index: Integer; NodeData: TStringList; var Members: TStringList): boolean;

    function GetMute: Boolean;
    function GetVolume: Integer;
    procedure SetMute(Mute: Boolean);
    procedure SetVolume(Percentage: Integer);

    function IsAutoConnect: boolean;
    function IsScriptInitialized: boolean;
    function IsStartCanceled: boolean;
    function IsStartCompleted: boolean;

    function CanShowProgress: boolean;
    function CanShowProgressDialog: boolean;

    { Obex folder routines }
    function FindObexFolderNode(AType: byte): PVirtualNode; // 0-pics,1-snds
    function FindObexFolderName(AType: byte): WideString; // 0-pics,1-snds

    { Obex routines within Connect/disconnect block }
    procedure ObexConnect(Target: String = '');
    procedure ObexDisconnect;

    function ObexGetObject(Path: Widestring; var Where: TStringList;
      progress: boolean = False; FriendlyName: string = ''): cardinal; overload;
    function ObexGetObject(Path: Widestring; var stream: TStream;
      progress: boolean = False): cardinal; overload;
    function ObexPutObject(Path: Widestring; Stream: TStream;
      progress: boolean = False): WideString;

    { Direct obex calls }
    procedure ObexPutFile(filename: WideString; Delete: boolean = False; Silent: boolean = False);
    procedure ObexGetFile(filename,objname: WideString; Silent: boolean = False);

    procedure StartupInitialize;
    procedure ViewInitialize;
    procedure ScriptInitialize;

    procedure SetTaskPercentageInc;
    procedure SetTaskPercentage(Pos: Integer; Max: Integer = 100; Loop: Boolean = False);
    procedure FloatingRectangles(Minimizing, OverrideUserSettings: Boolean);
    procedure ShowBaloonInfo(Text: WideString; Timeout: TBalloonHintTimeOut = 10; Where: TCoolTrayIcon = nil; IconT: TBalloonHintIcon = bitInfo);
    procedure ShowBaloonError(Text: WideString; Timeout: TBalloonHintTimeOut = 10);

    { Explorer properties }
    function FindExplorerChildNode(Named: WideString; RootNode: PVirtualNode = nil): PVirtualNode;
    function FindExplorerPhoneNode(Number: String; RootNode: PVirtualNode): PVirtualNode;
    procedure ShowExplorerProperties(Node: PVirtualNode);
    procedure SetExplorerNode(Node: PVirtualNode);

    function IsT610Clone(BrandName: WideString = ''): Boolean;
    function IsK610Clone(BrandName: WideString = ''): Boolean;
    function IsK700Clone(BrandName: WideString = ''): Boolean;    // mostly compatible with T610
    function IsK750Clone(BrandName: WideString = ''): Boolean;
    function IsT610orBetter(BrandName: WideString = ''): Boolean; // for T610 and later/better phones
    function IsK700orBetter(BrandName: WideString = ''): Boolean; // for K700 and later/better phones
    function IsK750orBetter(BrandName: WideString = ''): Boolean; // for K750 and later/better phones
    function IsK610orBetter(BrandName: WideString = ''): Boolean; // for K610 and later/better phones
    function IsWalkmanClone(BrandName: WideString = ''): Boolean; // only detects if phone has MediaPlayer
  published
    procedure ActionToolsEditProfileExecute(Sender: TObject);
    procedure Explore(Node: PVirtualNode);
    //
    property PhoneIdentity: string read GetPhoneIdentity write SetPhoneIdentity;
    property ScriptFilename: WideString read FScriptFile;
    property PhoneModel: String read FPhoneModel;
    //
    property LastGroupCreated: WideString read FLastGroupCreated;
    property PortableModeActivated: boolean read FPortableMode write FPortableMode;
  end;

var
  Form1: TForm1;
  ExePath: WideString;

{ Wait seconds if < 100, else miliseconds, but one can force as miliseconds
  Note that passed by time is checked in steps of 10 miliseconds }
procedure WaitASec(Seconds: integer = 1; ForceMSecs: boolean = False);

function EvenQuotes(const Str: WideString): Boolean;

{ The default TFont uses "MS Sans Serif" which doesn't work well with most non-ANSI characters.
  I'd recommend using a TrueType font such as "Tahoma" if it is installed on the machine.
  To make TFont use a different font like "Tahoma" add this to the first line in the project:

    Graphics.DefFontData.Name := 'Tahoma';

  You might have to include "Graphics" in the file's uses clauses.  Furthermore, adding this line
  of code to the project will cause the changed setting to only be applied at runtime, not at design time.
  To make a designtime change, you'd have to add this line to the initialization section of a unit in a
  design package.
  Regarding the IDE, I use GExperts to change the font of the Object Inspector.  The Wide String List
  editor uses the font used by the object inspector.
  Also keep in mind that the font used by certain message boxes come from that set by Windows' Display
  properties. }
procedure SetDefaultFont;

var WaitCompleteIsBusyEvent, WaitCompleteEvent: Cardinal;

const
  HelpTopics: array[1..1] of WideString = ( // do not localize!
    'html/welcome.htm'
  );

procedure ShowHelpPopup(Where: TPoint; ContextId: Integer); overload;
procedure ShowHelpPopup(Where: TPoint; ShowText: string); overload;

implementation

uses
  gnugettext, gnugettexthelpers, cUnicodeCodecs, cPortCtl, uNewAlarm, uRegistry,
  uThreadSafe, JclSysInfo, ShlObj, uCalling, uAbout, uOptions, uOptionsPage, uNewMessage, uMobileAgentUI,
  uPostNote, uGlobal, uEditProfile, uPostURL, uConnProgress, uComposeSMS, uVersion, uStatusDlg, TeEngine,
  uFolderProps, Types, uOfflineProfile, uFMASync, uOutlookSync, uPromptConflict, uChooseLink, uLogObserverWriter,
  uOrganizeFavs, uCallContact, uAddToPhonebook, StrUtils, uLogWriters, janXMLParser2, uInputQuery,
  uVBase, uVCalendar, uSplash, uConflictChanges, jclShell, MobileAgent_TLB, UrlMOn, uDialogs, uNewDeviceWizard,
  uWelcome, LMDGradient, uBrowseFolders, JwaHtmlHelp, uPassword, uPortable;

{$R *.dfm}

{ Globals }

function HtmlHelpFile: string;
begin
  Result := ExtractFileDir(Application.ExeName) + '\help\' +
    ChangeFileExt(ExtractFileName(Application.ExeName),'.chm');
end;

procedure HtmlPopup(Where: TPoint; ContextId: Integer; ShowText: WideString = '');
var
  Popup: THHPopup;
  s: WideString;
begin
  FillChar(Popup, SizeOf(Popup), 0);
  Popup.cbStruct := SizeOf(Popup);
  Popup.hinst_ := 0;
  if ShowText = '' then begin
    Popup.idString := 1;
    Popup.pszText := nil;
  end
  else begin
    Popup.idString := 0;
    Popup.pszText := PWideChar(ShowText);
  end;
  Popup.pt.x := Where.X;
  Popup.pt.y := Where.Y;
  Popup.clrForeGround := TColorRef(-1);
  Popup.clrBackground := TColorRef(-1);
  Popup.rcMargins := Rect(-1, -1, -1, -1);
  Popup.pszFont := '';
  if ShowText = '' then begin
    if (ContextId >= Low(HelpTopics)) and (ContextId <= High(HelpTopics)) then begin
      s := HtmlHelpFile + '::/' + HelpTopics[ContextId];

⌨️ 快捷键说明

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