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

📄 unit1.pas

📁 FMA is a free1 powerful phone editing tool allowing users to easily manage all of the personal data
💻 PAS
📖 第 1 页 / 共 5 页
字号:
      HtmlHelp(0, PWideChar(s), HH_DISPLAY_TOC, DWORD(@Popup));
    end;
  end
  else
    HtmlHelp(0, nil, HH_DISPLAY_TEXT_POPUP, DWORD(@Popup));
end;

{ TODO: Add L10N support }
const
  HelpPopups: array[1..1] of record id: integer; txt: string end = (
    (id: 101; txt: 'This is a sample help popup text.')
  );

procedure ShowHelpPopup(Where: TPoint; ContextId: Integer); overload;
var
  s: string;
  function GetPopupText: string;
  var
    i: integer;
  begin
    Result := '';
    for i := Low(HelpPopups) to High(HelpPopups) do
      if HelpPopups[i].id = ContextId then begin
        Result := HelpPopups[i].txt;
        break;
      end;
  end;
begin
  s := GetPopupText;
  if s <> '' then
    HtmlPopup(Where,0,s)
  else
    HtmlPopup(Where,ContextId);
end;

procedure ShowHelpPopup(Where: TPoint; ShowText: string); overload;
begin
  HtmlPopup(Where,0,ShowText);
end;

procedure SetDefaultFont;
var
  lf: LOGFONT;
  nc: NONCLIENTMETRICS;
begin
  if SystemParametersInfo(SPI_GETNONCLIENTMETRICS,SizeOf(nc),@nc,SPIF_SENDCHANGE) then
    lf := nc.lfMessageFont
  else begin
    if not SystemParametersInfo(SPI_GETICONTITLELOGFONT,SizeOf(lf),@lf,SPIF_UPDATEINIFILE) then begin
      Graphics.DefFontData.Name := 'MS Shell Dlg';
      exit;
    end;
  end;
  Graphics.DefFontData.Name := StrPas(@(lf.lfFaceName[0]));
  Graphics.DefFontData.Height := lf.lfHeight;
  Graphics.DefFontData.Charset := DEFAULT_CHARSET;
end;

function EvenQuotes(const Str: WideString): Boolean;
var
  P: Integer;
  WS: WideString;
begin
  WS := Str;
  Result := False;
  repeat
    { D7 code
    P := PosEx('"', S, P + 1); }
    { D6 code }
    P := Pos(WideString('"'),WS); Delete(WS,1,P);
    {}
    Result := not Result;
  until P = 0;
end;

procedure WaitASec(Seconds: integer; ForceMSecs: boolean);
var
  time: cardinal;
begin
  if Seconds < 1 then Seconds := 1;
  if (Seconds < 100) and not ForceMSecs then
    time := GetTickCount + cardinal(1000*Seconds)
  else
    time := GetTickCount + cardinal(Seconds);
  while (GetTickCount < time) and not Application.Terminated do begin
    Sleep(10);
    Application.ProcessMessages;
  end;
end;

{ Form1 - Codec developer tools }

procedure TForm1.Button4Click(Sender: TObject);
begin
  TntEdit2.Text := WideStringToUTF8String(TntEdit1.Text);
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
  TntEdit2.Text := UTF8StringToWideString(TntEdit1.Text);
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
  TntEdit2.Text := GSMEncodeUcs2(TntEdit1.Text);
end;

procedure TForm1.Button7Click(Sender: TObject);
begin
  TntEdit2.Text := GSMDecodeUcs2(TntEdit1.Text);
end;

procedure TForm1.Button8Click(Sender: TObject);
begin
  TntEdit2.Text := Str2QP(TntEdit1.Text);
end;

procedure TForm1.Button9Click(Sender: TObject);
begin
  TntEdit2.Text := QP2Str(TntEdit1.Text);
end;

procedure TForm1.Button12Click(Sender: TObject);
begin
  TntEdit2.Text := HTMLEncode(TntEdit1.Text);
end;

var LogObserverWriter: TLogObserverWriter = nil;
procedure TForm1.TntButton1Click(Sender: TObject);
begin
  TntEdit2.Text := HTMLDecode(TntEdit1.Text);
end;

procedure TForm1.TntButton2Click(Sender: TObject);
begin
  TntEdit2.Text := GSMEncode7Bit(TntEdit1.Text);
end;

procedure TForm1.TntButton3Click(Sender: TObject);
begin
  TntEdit2.Text := GSMDecode7Bit(TntEdit1.Text);
end;

procedure TForm1.TntButton4Click(Sender: TObject);
begin
  TntEdit2.Text := GSMEncode8Bit(TntEdit1.Text);
end;

procedure TForm1.TntButton5Click(Sender: TObject);
begin
  TntEdit2.Text := GSMDecode8Bit(TntEdit1.Text);
end;

{ Form1 }

procedure TForm1.Button1Click(Sender: TObject);
var
  str: TMemoryStream;
begin
  if RadioButton2.Checked then
    ObexConnect(Edit2.Text)
  else
    ObexConnect(ObexFolderBrowserServiceID);
  str := TMemoryStream.Create;
  try
    FObex.GetObject(cbObex.Text,str);
    memo1.Lines.LoadFromStream(str);
  finally
    str.free;
    ObexDisconnect;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  vCard: TVCard;
begin
  vCard := TVCard.Create;
  try
    vcard.Raw := Memo1.Lines.AnsiStrings;
    memo2.Lines.Clear;
    memo2.Lines.Add('Type = ' + vcard.VType); // do not localize
    memo2.Lines.Add('Version = ' + vcard.Version); // do not localize
    memo2.Lines.Add('Name = ' + vcard.Name); // do not localize
    memo2.Lines.Add('Surname = ' + vcard.Surname ); // do not localize
    memo2.Lines.Add('Home = ' + vcard.TelHome ); // do not localize
    memo2.Lines.Add('Work = ' + vcard.TelWork ); // do not localize
    memo2.Lines.Add('Fax = ' + vcard.TelFax  ); // do not localize
    memo2.Lines.Add('Other = ' + vcard.TelOther ); // do not localize
    memo2.Lines.Add('Title = ' + vcard.Title ); // do not localize
    memo2.Lines.Add('Org = ' + vcard.Org ); // do not localize
    memo2.Lines.Add('Email = ' + vcard.email  ); // do not localize
    memo2.Lines.Add('XLUID = ' + vcard.LUID ); // do not localize
    if vcard.Photo <> nil then begin
      Image.Picture.Assign(vCard.Photo);
    end;
  finally
    vCard.free;
  end;
end;

procedure TForm1.Button10Click(Sender: TObject);
begin
  ObexConnect(ObexFolderBrowserServiceID);
  try
    memo1.Lines.Clear;
    FObex.ChangeDir(cbObex.Text);
    memo1.Lines.Add('OK') // do not localize
  finally
    ObexDisconnect;
  end;
end;

procedure TForm1.Button11Click(Sender: TObject);
var
  sl: TStringStream;
begin
  ObexConnect(ObexFolderBrowserServiceID);
  sl := TStringStream.Create('');
  try
    FObex.ChangeDir('');
    FObex.ChangeDir(cbObex.Text);
    FObex.List(sl);
    memo1.Lines.LoadFromStream(sl);
    if memo1.Lines.Count <> 0 then
      if Pos('encoding="UTF-8"',memo1.Lines[0]) <> 0 then
        memo1.Text := UTF8StringToWideString(memo1.Text);
  finally
    sl.free;
    ObexDisconnect;
  end;
end;

{ Form1 }

procedure TForm1.ActionConnectionConnectExecute(Sender: TObject);
var
  dlg: TfrmConnect;
  i,tid: Integer;
  so1,so2,so3,so4,so5: boolean;
begin
  if FConnectingStarted or FConnected then exit;
  if (PhoneIdentity = '') and not Assigned(frmNewDeviceWizard) then begin
    { No phone profile created yet }
    GettingStarted1.Click;
    exit;
  end;

  Timer1.Enabled := False;
  if not Visible and (FormStorage1.StoredValue['StartMinimized'] = False) then begin // do not localize
    Show;
    Update;
  end;
  try
    { Clear flags }
    ThreadSafe.Timedout := False;
    FAutoConnectionError := False;
    FConnectingStarted := True;
    FConnectingComplete := False;
    FStartupSyncFinished := False;
    FConnectionError := False;
    FConnected := False;
    ThreadSafe.Abort := False;
    ThreadSafe.AbortDetected := False;
    FEmergencyMode := True;
    FamCommand := '';
    try
      { Do connect }
      DoConnect;
      while not (FConnected or ThreadSafe.AbortDetected or ThreadSafe.Timedout or
        FConnectionError or Application.Terminated) do
        Application.ProcessMessages;
      if Application.Terminated then Abort;

      { Check for error }
      if FConnectionError then begin
        if not FAutoConnectionError then
          if ThreadSafe.AbortDetected then
            if FBatteryLow then
              raise Exception.Create(_('Connection aborted by user or phone battery is too low'))
            else
              raise Exception.Create(_('Connection aborted by user'))
          else
            raise Exception.Create(_('Connection failed'))
        else
          exit;
      end;

      if FConnected then begin
        { do not show Getting Started on startup anymore }
        Form1.FormStorage1.StoredValue['First Run'] := False; // do not localize
        { Allow auto-connect feature (if checked) }
        ActionConnectionMonitor.Tag := 1;
        { Done }
        FConnectingComplete := True;
        ExplorerNew.Repaint;
      end
      else
        Abort;
    except
      On E:Exception do begin
        Status(E.Message);
        DoDisconnect;
        { if aborted raise here to show this to user, and to
          cancel next connect operations.
        if not IsAutoConnect or ThreadSafe.AbortDetected then
          raise;
        }
       if ThreadSafe.Timedout or ThreadSafe.AbortDetected or not FConnected then Abort;
      end;
    end;
  finally
    Timer1.Enabled := True;
    FConnectingStarted := False;
  end;

  { Connection is completed successfuly }
  if FConnected and not FStartupSyncFinished then begin
    FStartupSyncFinished := True;
    { Perform any startup operations }
    dlg := GetProgressDialog;
    try
      tid := dlg.CurrentTaskID;
      { TODO: Add support for AutoTasks, AutoNotes options }
      so1 := FormStorage1.StoredValue['AutoInbox']; // do not localize
      so2 := FormStorage1.StoredValue['AutoSync']; // do not localize
      so3 := FormStorage1.StoredValue['AutoSyncOutlook']; // do not localize
      so4 := FormStorage1.StoredVa

⌨️ 快捷键说明

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