unewdevicewizard.pas

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

      lblSearchInfo.Caption := _('Searching Bluetooth...') + Reason;
      Application.ProcessMessages;
      if FCanceled then exit;
      try
        FConnectionType := 0;
        if Assigned(BtDevices) then
          for i := 0 to BtDevices.Count-1 do begin
            if FCanceled or Application.Terminated then break;
            DevName := BtDevices[i].btDeviceName;
            DevAddr := IntToHex(BtDevices[i].btDeviceAddr,12);
            LocalWBtSocket.Addr := DevAddr;
            LocalWBtSocket.Port := '0';
            LocalWBtSocket.Connect;
            try
              while LocalWBtSocket.State = wsConnecting do WaitASec(50,True);
              ProbeDevice;
            finally
              if LocalWBtSocket.State = wsConnected then LocalWBtSocket.Close;
            end;
          end;
      except
      end;
    end;

    // infrared
    if cbSearchIR.Checked then begin
      try
        IrDevices := LocalWIrSocket.GetConnectedDevices;
      except
        AddDevice(_('Native Infrared is not supported!'));
      end;
      lblSearchInfo.Caption := _('Searching Infrared...') + Reason;
      Application.ProcessMessages;
      if FCanceled then exit;
      try
        FConnectionType := 1;
        if Assigned(IrDevices) then
          for i := 0 to IrDevices.Count-1 do begin
            if FCanceled or Application.Terminated then break;
            DevName := IrDevices.Items[i].irdaDeviceName;
            DevAddr := IntToHex(DWORD(IrDevices.Items[i].irdaDeviceID[1]),8);
            LocalWIrSocket.DeviceID := IrDevices.Items[i].irdaDeviceID;
            LocalWIrSocket.Connect;
            try
              while LocalWIrSocket.State = wsConnecting do WaitASec(50,True);
              ProbeDevice;
            finally
              if LocalWIrSocket.State = wsConnected then LocalWIrSocket.Close;
            end;
          end;
      except
      end;
    end;

    // serial cable
    if cbSearchCOM.Checked then begin
      lblSearchInfo.Caption := _('Searching Ports...') + Reason;
      Application.ProcessMessages;
      if FCanceled then exit;
      FConnectionType := 2;
      DevName := '';

      ComPortList := TStringList.Create;
      try
        EnumLikelyComPorts(ComPortList);
        for i := 0 to ComPortList.Count-1 do
        try
          if FCanceled or Application.Terminated then break;
          LocalComPort.Port := ComPortList[i];
          LocalComPort.BaudRate := br9600;
          LocalComPort.FlowControl.ControlRTS := rtsHandshake;
          LocalComPort.FlowControl.ControlDTR := dtrHandshake;
          LocalComPort.Open;

          // Give the chance to run the com thread.
          // The main event loop in TComThread.Execute have to be started (see the CPort.pas)
          WaitASec(200, True);

          try
            DevAddr := ComPortList[i];
            ProbeDevice;
          finally
            LocalComPort.Close;
          end;
        except
        end;
      finally
        ComPortList.Free;
      end;
    end;

    FSearchCompleted := not FCanceled;
  finally
    if Assigned(IrDevices) then IrDevices.Free;
    if Assigned(BtDevices) then BtDevices.Free;
    lblSearchInfo.Caption := _('Select prefered phone device and click Next to continue.');
    NoItemsPanel.Visible := lvDevices.Items.Count = 0;
    Animate1.Active := False;
    Animate1.Visible := False;
    PreviousButton.Visible := True;
    NextButton.Visible := True;
    RefreshButton.Enabled := True;
  end;
end;

procedure TfrmNewDeviceWizard.LocalComPortRxChar(Sender: TObject;
  Count: Integer);
var
  c: char;
  i: Integer;
  buffer: String;
  PStr: PChar;
begin
  if FConnectionType = 0 then begin
    SetLength(buffer, 2048);
    SetLength(buffer, LocalWBtSocket.Receive(@buffer[1], 2048));
  end
  else if FConnectionType = 1 then begin
    SetLength(buffer, 2048);
    SetLength(buffer, LocalWIrSocket.Receive(@buffer[1], 2048));
  end
  else begin
    SetLength(buffer, Count);
    LocalComPort.ReadStr(buffer, Count);
  end;

  if ThreadSafe.DoCharConvertion then
    buffer := GSMDecode7Bit(buffer);

  { process received data }
  for i := 1 to length(buffer) do begin
    c := buffer[i];
    //if ThreadSafe.DoCharConvertion then c := ConvertCharSet(c);
    case c of
      #00:;
      #10:;
      #13:
        begin
          if length(trim(FMessageBuf)) > 0 then
          begin
            PStr := StrNew(PChar(FMessageBuf));
            PostMessage(Handle, WM_HANDLEMESSAGE, Integer(PStr), 0);
          end;
          FMessageBuf := '';
        end;
      else begin
        FMessageBuf := FMessageBuf + c;
      end;
    end;
    if (FMessageBuf = 'OK') and (FMessageBuf <> '') then begin
      PStr := StrNew(PChar(FMessageBuf));
      PostMessage(Handle, WM_HANDLEMESSAGE, Integer(PStr), 0);
      FMessageBuf := '';
    end;
  end;
end;

procedure TfrmNewDeviceWizard.HandleMessage(var Msg: TSearchHandleMessage);
var
  s: string;
begin
  s := Msg.Message;
  StrDispose(Msg.Message);
  FReceived := (CompareText('OK',s) = 0) or (CompareText('ERROR',s) = 0);
  FRxBuffer.Add(s);
  inherited;
end;

procedure TfrmNewDeviceWizard.TxAndWait(Data: string);
var
  FMSec: cardinal;
begin
  FReceived := False;
  FMessageBuf := '';
  FRxBuffer.Clear;

  if ThreadSafe.DoCharConvertion then
    Data := GSMEncode7Bit(Data);

  { Send command }
  if FConnectionType = 0 then LocalWBtSocket.SendStr(Data + #13) // Blutooth
  else if FConnectionType = 1 then LocalWIrSocket.SendStr(Data + #13) // Infrared
       else LocalComPort.WriteStr(Data + #13); // Serial

  { Set timeout, max 5 seconds }
  FMSec := ThreadSafe.InactivityTimeout;
  if FMSec > 5000 then FMSec := 5000;
  FMSec := GetTickCount + FMSec;

  { Wait for response }
  while not FCanceled and not FReceived and not Application.Terminated do begin
    WaitASec(10,True);
    if GetTickCount > FMSec then
      raise EInOutError.Create('Timeout'); // do not localize
  end;
  if FReceived and (CompareText('ERROR',FRxBuffer[0]) = 0) then
    raise EInOutError.Create('AT Error'); // do not localize
end;

procedure TfrmNewDeviceWizard.OnSocketDataAvailable(Sender: TObject;
  Error: Word);
begin
  if Error = 0 then LocalComPortRxChar(nil, 0);
end;

procedure TfrmNewDeviceWizard.TntPopupMenu1Popup(Sender: TObject);
begin
  Refresh1.Enabled := RefreshButton.Enabled;
end;

procedure TfrmNewDeviceWizard.Refresh1Click(Sender: TObject);
begin
  DoSearch;
end;

procedure TfrmNewDeviceWizard.AsIcons1Click(Sender: TObject);
begin
  lvDevices.ViewStyle := vsIcon;
end;

procedure TfrmNewDeviceWizard.AsList1Click(Sender: TObject);
begin
  lvDevices.ViewStyle := vsReport;
end;

procedure TfrmNewDeviceWizard.TntFormDestroy(Sender: TObject);
begin
  FRxBuffer.Free;
end;

procedure TfrmNewDeviceWizard.AddDevice(Text: WideString; Address: string;
  FriendlyName, Manufacturer: WideString);
begin
  { for modems: ImageIndex := 3 }
  if (Text <> '') and (WidePos('MODEM',WideUpperCase(Text)) = 0) then
    with lvDevices.Items.Add do begin
      Caption := Text;        // Device name
      SubItems.Add(Address);  // Peer Bluetooth address or COM port name
      SubItems.Add(FriendlyName);
      SubItems.Add(Manufacturer);
      if Address <> '' then begin
        case FConnectionType of
          0: ImageIndex := 0;
          1: ImageIndex := 1;
          2: ImageIndex := 2;
        end;
        StateIndex := 5;      // Phone found!
      end
      else 
        ImageIndex := 4;      // No address, so it is a warning message
      Data := Pointer(FConnectionType); // Connection type
    end;
end;

procedure TfrmNewDeviceWizard.DoCalibrateConnection;
var
  i: integer;
  dlg: TfrmStatusDlg;
begin
  if Integer(lvDevices.Selected.Data) = ndcSerial then // serial?
    try
      dlg := ShowStatusDlg(_('Calibrating Port Speed...'),poMainFormCenter);
      try
        if Form1.IsK750orBetter(FSelected.DeviceName) then begin
          { K750 working settings: Port:'COM X', Baud:256000, RTS:Handshake, DTR:Enabled }
          LocalComPort.BaudRate := br256000;
          LocalComPort.FlowControl.ControlRTS := rtsHandshake;
          LocalComPort.FlowControl.ControlDTR := dtrEnable;
        end;
        { Get already tested speed }
        i := Ord(LocalComPort.BaudRate);
        while i < Ord(High(TBaudRate)) do begin
          { try next higher speed }
          inc(i);
          LocalComPort.BaudRate := TBaudRate(i);
          LocalComPort.Open;

          // Give the chance to run the com thread.
          // The main event loop in TComThread.Execute have to be started (see the CPort.pas)
          WaitASec(200, True);

          try
            try
              { Check if we can transmit/receive on that speed }
              TxAndWait('ATE0'); // do not localize
              if not FReceived then Abort; // just in case
            except
              { Revert to previous speed and exit }
              LocalComPort.BaudRate := TBaudRate(i-1);
              break;
            end;
          finally
            LocalComPort.Close;
          end;
        end;
      finally
        dlg.Free;
      end;
    except
      // be silent
    end;
end;

procedure TfrmNewDeviceWizard.cbDeviceReadyClick(Sender: TObject);
begin
  FSearchCompleted := False;
  NextButton.Enabled := cbDeviceReady.Checked and
    (cbSearchBT.Checked or cbSearchIR.Checked or cbSearchCOM.Checked);
  NextButton.Default := NextButton.Enabled;
  if cbDeviceReady.Checked then begin
    cbSearchBT.Enabled := True;
    cbSearchIR.Enabled := True;
    cbSearchCOM.Enabled := True;
    cbSearchAll.Enabled := True;
  end;
end;

procedure TfrmNewDeviceWizard.lvDevicesSelectItem(Sender: TObject;
  Item: TListItem; Selected: Boolean);
begin
  { Allow selection of devices which have Manufacturer field set, i.e. support AT+CGMI }
  NextButton.Enabled := Assigned(lvDevices.Selected) and (lvDevices.Selected.StateIndex = 5);
  NextButton.Default := NextButton.Enabled;
end;

procedure TfrmNewDeviceWizard.OnUSBDeviceChange(Sender: TObject);
begin
  if nbWizard.PageIndex = piSearch then begin
    Timer1.Enabled := False;
    Timer1.Enabled := True;
  end;
end;

procedure TfrmNewDeviceWizard.Timer1Timer(Sender: TObject);
begin
  if nbWizard.PageIndex = piSearch then begin
    if RefreshButton.Enabled then begin
      Timer1.Enabled := False;
      DoSearch(_('USB device arrival or removed'));
    end
    else
      { Restart searching due to device change }
      FCanceled := True;
  end
  else
    Timer1.Enabled := False;
end;

function TfrmNewDeviceWizard.Get_DontShowVis: boolean;
begin
  Result := cbDontShow.Visible;
end;

procedure TfrmNewDeviceWizard.Set_DontShowVis(const Value: boolean);
begin
  cbDontShow.Visible := Value;
  lblWelcomeNext.Visible := not Value;
end;

function TfrmNewDeviceWizard.Get_DontShow: boolean;
begin
  Result := IsDontShowVisible and cbDontShow.Checked;
end;

procedure TfrmNewDeviceWizard.cbDontShowClick(Sender: TObject);
begin
  if cbDontShow.Checked then
    CancelButton.Caption := _('&Close')
  else
    CancelButton.Caption := _('&Cancel');
end;

procedure TfrmNewDeviceWizard.DoCheckObex;
var
  dlg: TfrmStatusDlg;
begin
  if Integer(lvDevices.Selected.Data) = ndcSerial then // serial?
    try
      dlg := ShowStatusDlg(_('Checking OBEX support...'),poMainFormCenter);
      try
        LocalComPort.Open;

        // Give the chance to run the com thread.
        // The main event loop in TComThread.Execute have to be started (see the CPort.pas)
        WaitASec(200, True);

        try
          TxAndWait('ATE0'); // do not localize
          if not FReceived then Abort; // just in case
          
          try
            TxAndWait('AT*EOBEX=?'); // do not localize
            if not FReceived then begin
              FSelected.DisableObex := True;
              FSelected.DisableIrmcSync := True;
            end;
          except
          end;
          if FSelected.DisableObex then
            try
              TxAndWait('AT+CPROT=?'); // do not localize
              FSelected.DisableObex := not FReceived;
              FSelected.DisableIrmcSync := not FReceived;
            except
            end;
        finally
          LocalComPort.Close;
        end;
      finally
        dlg.Free;
      end;
    except
      // be silent
    end;
end;

procedure TfrmNewDeviceWizard.lvDevicesInsert(Sender: TObject;
  Item: TListItem);
begin
  NoItemsPanel.Visible := False;
end;

procedure TfrmNewDeviceWizard.cbSearchAllClick(Sender: TObject);
begin
  cbSearchBT.Checked := cbSearchAll.Checked;
  cbSearchIR.Checked := cbSearchAll.Checked;
  cbSearchCOM.Checked := cbSearchAll.Checked;
  cbDeviceReadyClick(nil);
end;

procedure TfrmNewDeviceWizard.EnumLikelyComPorts(var AList: TStringList);
var
  reg: TRegistry;
  i: integer;
  s: string;
  Ports: TStrings;
begin
  AList.Clear;
  reg := TRegistry.Create(KEY_READ);
  try
    reg.RootKey := HKEY_LOCAL_MACHINE;
    if reg.OpenKey('HARDWARE\DEVICEMAP\SERIALCOMM', False) then
      try
        Ports := TStringList.Create;
        try
          reg.GetValueNames(Ports);
          for i := 0 to Ports.Count-1 do begin
            if Ports[i] <> '' then begin
              if (Pos('\', Ports[i]) = 0) or (Pos('obex', Ports[i]) <> 0) or (Pos('mgmt', Ports[i]) <> 0) then
                Continue; // these ports are evil, hide them :)
              s := reg.ReadString(Ports[i]);
              AList.Add(s);
            end;
          end;
        finally
          Ports.Free;
        end;
      finally
        reg.CloseKey;
      end;
  finally
    reg.Free;
  end;
  AList.Sort;
end;

end.