uobex.pas

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

unit uObex;

{
*******************************************************************************
* Descriptions: OBEX Implementation
* $Source: /cvsroot/fma/fma/uObex.pas,v $
* $Locker:  $
*
* Todo:
*    - see code comments "todo:"
*
* Change Log:
* $Log: uObex.pas,v $
*
*******************************************************************************
}

interface

uses Windows, TntWindows, Classes, TntClasses, Forms, TntForms, Dialogs, TntDialogs;

const
  ObexNoSession = cardinal(-1);

  ObexFolderBrowserServiceID: string[16] = #$F9#$EC#$7B#$C4#$95#$3C#$11#$D2#$98#$4E#$52#$54#$00#$DC#$9E#$09; // do not localize
  ObexFolderListing: string              = 'x-obex/folder-listing'#00; // do not localize

  ObexSyncMLDataSyncXML: string          = 'application/vnd.syncml+xml'; // do not localize
  ObexSyncMLDataSyncWirelessXML: string  = 'application/vnd.syncml+wbxml'; // do not localize
  ObexSyncMLDevManXML: string            = 'application/vnd.syncml.dm+xml'; // do not localize
  ObexSyncMLDevManWirelessXML: string    = 'application/vnd.syncml.dm+wbxml'; // do not localize

type
  TObexItem = class(TObject)
  private
  protected
    FPacketData: String;
    procedure SetRaw(buffer: String); virtual;
    function GetRaw: String; virtual;
    function GetPacketData: String; virtual;
    procedure SetPacketData(const Value: String); virtual;
    function GetPacketLen: Integer; virtual;
  public
    PacketID: Byte;
    property PacketLen: Integer read GetPacketLen;
    property PacketData: String read GetPacketData write SetPacketData;
    property Raw: String read GetRaw write SetRaw;
    constructor Create(HID: byte = 0; data: String='');
  end;

  // TODO: Add TObexWideStrSeq
  TObexName = class(TObexItem)
  protected
    procedure SetRaw(buffer: String); override;
    function GetRaw: String; override;
  public
    name: WideString;
    constructor Create(nameStr: WideString='');
  end;

  TObexDescription = class(TObexName)
  public
    constructor Create(descrStr: WideString='');
    property descr: WideString read name write name;
  end;

  TObexByteSeq = class(TObexItem)
  protected
    seqbuffer: String;
    procedure SetRaw(buffer: String); override;
    function GetRaw: String; override;
  public
    constructor Create(HID: byte; byteseq: String='');
  end;

  TObexTarget = class(TObexByteSeq)
  public
    constructor Create(targetStr: String='');
    property Target: String read seqbuffer write seqbuffer;
  end;

  TObexWho = class(TObexByteSeq)
  public
    constructor Create(whoStr: String='');
    property Who: string read seqbuffer write seqbuffer;
  end;

  TObexType = class(TObexByteSeq)
  public
    constructor Create(typeStr: String='');
    property MimeType: string read seqbuffer write seqbuffer;
  end;

  // TODO: Add TObexCardinal
  TObexLength = class(TObexItem)
  protected
    procedure SetRaw(buffer: String); override;
    function GetRaw: String; override;
  public
    size: Cardinal;
    constructor Create(s: Cardinal=0);
  end;

  TObexConnection = class(TObexLength)
  public
    constructor Create(cid: Cardinal=0);
    property ConnectionID: cardinal read size write size;
  end;

  TObexItemList = class(TList)
  protected
    function  GetObexItem(Index: integer): TObexItem;
    procedure PutObexItem(Index: integer; ObexItem: TObexItem);
  public
    property Items[Index: integer]: TObexItem read GetObexItem write PutObexItem;
    destructor Destroy; override;
    procedure FreeAll;
  end;

  TObexPacket = class(TObexItem)
  private
    function GetBody: TObexItem;
  protected
    function GetPacketData: String; override;
    procedure SetPacketData(const Value: String); override;
    function GetConnectionID: cardinal;
    function GetLength: integer;
    function GetWho: string;
  public
    Child: TObexItemList;
    property Body: TObexItem read GetBody;
    constructor Create(HID: byte = 0; data: String='');
    destructor Destroy; override;
  end;

  TObexDirList = class(TObexPacket)
    constructor Create;
  end;

  TObexSetPath = class(TObexPacket)
  protected
    procedure SetRaw(buffer: String); override;
    function GetRaw: String; override;
    function GetPacketLen: Integer; override;
  public
    Flags,Constants: Byte;
    constructor Create(path: String=''; GoUpFirst: boolean = False; DontCreateDir: boolean = True);
  end;

  TObexConnectPacket = class(TObexItem)
  protected
    procedure SetRaw(buffer: String); override;
    function GetRaw: String; override;
  public
    // TODO: Add session id support
    ObexVersion: Integer;
    Flag: byte;
    MaxPacketLen: Integer;
    Target: String;
    constructor Create(HID: byte=0; MaxLen: Integer=0; TargetStr: String='');
  end;

  TObexTargetType = (ocOther, ocSyncML, ocIrmcSync, ocFolderBrowseing);

  TObex = class(TObject)
  private
    FAbort: Boolean;
    FLastReceivedPacket: String;
    packetLen: Integer;
    FRxBuffer: String;
    FPacketsize: Integer;
    ConnID: cardinal;
    RcPackets: TStringList;
    function CheckForPacket: boolean;
    procedure GetReceivedObject(var obj: TObexPacket);
    procedure SentObject(obexItem: TObexItem); overload;
    procedure SentObject(HID: byte = 0; data: String=''); overload;
    procedure DoAbort;
    procedure ClearRxBuffers;
  protected
    FLastErrorCode: integer;
    FIsAborted,SendingData: boolean;
    TargetType: TObexTargetType;
  public
    Connected: Boolean;
    MaxPacketSize: Integer;
    debugobex: Boolean;
    constructor Create;
    destructor Destroy; override;
    { For incomming data }
    procedure OnRxChar(c: char);
    { Connection }
    procedure Connect(Target: String='');
    procedure Disconnect;
    { Schedule abort operation }
    function IsAborted: boolean;
    procedure Abort;
    { Dangerous! Do not you if you don't know what are you doing! }
    procedure ForceAbort;
    { Empty dir changes to root folder }
    function ChangeDir(name: WideString): boolean;
    { List folder contents, Result is a XML document (encoded) }
    function List(var Xml: TStringStream): cardinal;
    { Returns current LUID of the object if any. If the stream parameter
      is nil, the object will be deleted. }
    function PutObject(name: WideString; stream: TStream; progress: boolean = False;
      FriendlyName: string = ''): WideString;
    { Returns object size in bytes or 0 on failure. }
    function GetObject(path: WideString; var where: TMemoryStream; progress: boolean = False;
      FriendlyName: string = ''): cardinal;
    { Direct calss }
    procedure PutFile(filename: WideString; Delete: boolean = False);
    procedure GetFile(filename: WideString; objname: WideString = ''; Silent: boolean = False);
  published
    property LastErrorCode: integer read FLastErrorCode;
  end;

const
  FMaxLuidLen: cardinal = 12;

function bytestream2hex(byteStream: String; seperator: String=' '): String;

implementation

uses
  gnugettext, uLogger, uThreadSafe,
  Unit1, SysUtils, TntSysUtils, Math, uConnProgress, uDialogs;

{ TObex }

function TObex.ChangeDir(name: WideString): boolean;
var
  thisPacket: TObexSetPath;
  received: TObexPacket;
  wasconn: boolean;
  aname: WideString;
begin
  Result := False;
  wasconn := Connected;
  if not Connected then Connect; // Start OBEX Mode if it's nessesery
  try
    aname := name;
    if aname = '' then aname := '/';
    Log.AddCommunicationMessage('OBEX going into folder: ' + aname, lsDebug); // do not localize debug

    thisPacket := TObexSetPath.Create(name);
    try
      SentObject(thisPacket);
    finally
      thisPacket.Destroy;
    end;

    received := TObexPacket.Create;
    try
      GetReceivedObject(received);

      if received.PacketID <> $A0 then
        raise Exception.Create(_('Invalid Respond ') + bytestream2hex(received.Raw));

      //Log.AddCommunicationMessage('OBEX folder changed', lsDebug); // do not localize debug
      Result := True;
    finally
      received.Free;
    end;
  finally
    { Stop our connections only }
    if not wasconn then Disconnect;
  end;
end;

function TObex.CheckForPacket: boolean;
var
  s: string;
begin
  //Form1.VaCommRxChar(nil,0);
  if RcPackets.Count <> 0 then begin
    s := RcPackets[0];
    RcPackets.Delete(0);
    if debugobex then Log.AddCommunicationMessage('[RX] ' + bytestream2hex(s), lsDebug); // do not localize debug
    FLastReceivedPacket := s;
    SendingData := False;
    Result := True;
  end
  else
    Result := False;
end;

procedure TObex.Connect(Target: String);
var
  recpackt: TObexPacket;
  sent,received: TObexConnectPacket;
  whoreply: string;
begin
  if Connected then exit;

  ThreadSafe.AlreadyInUseObex := False;
  ThreadSafe.ObexConnecting := True;
  try
    repeat
      if Form1.FUseObexCompat then
        Form1.TxAndWait('AT+CPROT=0', 'CONNECT') // do not localize
      else
        Form1.TxAndWait('AT*EOBEX', 'CONNECT');  // do not localize
      if ThreadSafe.AlreadyInUseObex then begin
        // TODO: Text is not wrapped anymore.
        case MessageDlgW(_('OBEX session can not be established at this time, because '+
          'the service is busy!'+sLinebreak+sLinebreak+
          'Close any other Obex applications (maybe running in background), '+
          'or turn off and then back on your phone connection (disable then '+
          'enable Bluetooth, unplug then plug cable etc). Or check if you have '+
          'to answer on some connection question (contirmation) in your phone. '+
          'If nothing above helps restart your phone and try again.'+sLinebreak+sLinebreak+
          'Do you wish to try again or Cancel current operation?'),
          mtConfirmation, MB_YESNOCANCEL) of
          ID_YES: WaitASec;
          ID_NO: begin
            Form1.Status(_('OBEX is already in use'));
            raise Exception.Create(_('OBEX Connect: Already in use or Connect failed'));
          end;
          ID_CANCEL: begin
            Form1.ActionConnectionAbort.Execute;
            SysUtils.Abort;
          end;
        end;
      end
      else break;
    until False;
  except
    ThreadSafe.ObexConnecting := False;
    raise;
  end;
  
  try
    FIsAborted := False;
    FAbort := False;
    SendingData := False;
    Connected := True;
    ThreadSafe.ObexConnecting := False;
    Log.AddCommunicationMessage('OBEX Session Established', lsDebug); // do not localize debug
    WaitASec;
    if not Connected or FIsAborted then SysUtils.Abort;
    Log.AddCommunicationMessage('OBEX Negotiateing...', lsDebug); // do not localize debug
    sent := TObexConnectPacket.Create($80, MaxPacketSize, Target);
    try
      ClearRxBuffers;
      SentObject(sent);
      received := TObexConnectPacket.Create;
      recpackt := TObexPacket.Create;
      try
        if FLastReceivedPacket = '' then SysUtils.Abort;
        if ord(FLastReceivedPacket[1]) = $C3 then
          raise Exception.Create(_('OBEX: Access to this target is denied'));
        if ord(FLastReceivedPacket[1]) <> $A0 then
          raise Exception.Create(_('Invalid Respond ') + bytestream2hex(FLastReceivedPacket));

        // get packet size
        received.Raw := FLastReceivedPacket;
        FPacketsize := min(MaxPacketSize, received.MaxPacketLen);
        Log.AddCommunicationMessage('OBEX Negotiated: Packet Size = ' + IntToStr(FPacketsize), lsDebug); // do not localize debug
        // TODO: Add support for Obex timeout...
        // process optional headers, remove connect data (6 bytes + opcode)
        Delete(FLastReceivedPacket,1,7);
        recpackt.PacketData := FLastReceivedPacket;
        // get who reply (should be target)
        whoreply := recpackt.GetWho;
        if whoreply <> Target then
          raise Exception.Create(_('Wrong Who Received: ') + whoreply)
        else
          TargetType := ocOther;
          if whoreply <> '' then begin
            if AnsiCompareText(whoreply,ObexFolderBrowserServiceID) = 0 then
              TargetType := ocFolderBrowseing;
            if AnsiCompareText(whoreply,'IRMC-SYNC') = 0 then // do not localize
              TargetType := ocIrmcSync;
            if AnsiCompareText(whoreply,'SYNCML-SYNC') = 0 then // do not localize
              TargetType := ocSyncML;

            if (AnsiCompareText(whoreply,ObexFolderBrowserServiceID) = 0) or
              (AnsiCompareText(whoreply,ObexFolderListing) = 0) then
              whoreply := 'Folder Browsing'; // do not localize
            Log.AddCommunicationMessage('OBEX Negotiated: Application = ' + whoreply, lsDebug); // do not localize debug
          end;
        // get connection id
        ConnID := recpackt.GetConnectionID;
        if ConnID <> ObexNoSession then
          Log.AddCommunicationMessage('OBEX Negotiated: Connection = ' + IntToStr(ConnID), lsDebug); // do not localize debug
      finally
        received.Free;
        recpackt.Free;
      end;
    finally
      sent.Free;
    end;
  except
    Disconnect;
    raise;
  end;
end;

constructor TObex.Create;
begin
  RcPackets := TStringList.Create;